x chi può fare una modifica

[BEPPA51]

se è possibile modificare per 3 ambi somma uguale isotopi. grazie
Sub Main
Dim ruote(10)
Dim ruota(10)
Dim ruotee(10)
Dim n(10)im n1(10)
Dim poste(3)
Dim posta(1)
'posta(1) = 1
poste(2) = 1
poste(3) = 1
co = 0
so = CInt(InputBox("INSERISCI LA SOMMA DEI 2 AMBI ISOTOPI",,40))
ii = InputBox("INSERISCI L'ESTRAZIONE DI PARTENZA",,9000)
kk = InputBox("INSERISCI I COLPI DI GIOCO",,13)
ini = ii
fin = EstrazioneFin
For es = ini To fin
AvanzamentoElab Ini,fin,es
Messaggio " " & DataEstrazione(es) & " '[ Ambi somma 90 isotopi °Metodo di ananda - Script By Blackmore°]"
For r1 = 1 To 10 ' la 1°ruota cerca la condizione da bari a venezia
For r2 = r1 + 1 To 12 ' la 2°ruota dalla successiva (della 1° ruota)fino alla nazionale
If r2 = 11 Then r2 = 12
For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(es,r1,p1)
b = Estratto(es,r1,p2)
c = Estratto(es,r2,p1)
d = Estratto(es,r2,p2)
If a + b = so Then
If c + d = so Then
co = co + 1
casi = casi + 1
Scrivi String(110,"*") & " Caso n° " & Format2(casi),1
ColoreTesto 1
Scrivi DataEstrazione(es) & " - " & SiglaRuota(r1) & " - " & StringaEstratti(es,r1) & " - " & Format2(a) & "-" & Format2(b) & " = Somma " & so & " Isotopa",1
Scrivi DataEstrazione(es) & " - " & SiglaRuota(r2) & " - " & StringaEstratti(es,r2) & " - " & Format2(c) & "-" & Format2(d) & " = Somma " & so & " Isotopa",1
ColoreTesto 0
'ruote(1) = r1 : ruote(2) = r2
ruotee(1) = BA_ : ruotee(2) = PA_ :ruotee(3) = TU_
'ruota(4) = BA_ 'Se vuoi giocare gli ambi anche a tutte togli l'apice all'inizio della rig
n(1) = Figura(a)
n(2) = Figura(c)
n(3) = Fuori90(b - n(1) + d - Figura(c))
n(4) = Fuori90(Estratto(es,FI_ ,2)+0)
ImpostaGiocata 1,n,ruotee,poste,kk
Gioca es',1 ' se usate L8 o Lottodesk togliete la virgola e l'1 dopo gioca es
End If
End If
Next
Next
Next
Next
If ScriptInterrotto Then Exit For
Next
ScriviResoconto
End Sub

 

[GioRyuKen72]

Ciao Beppa, ho modificato aggiungendo il terzo ambo sullla terza ruota..
se ho capito bene

Anticipazione (Spoiler)

Sub Main
Dim ruote(10)
Dim ruota(10)
Dim ruotee(10)
Dim n(10)im n1(10)
Dim poste(3)
Dim posta(1)
'posta(1) = 1
poste(2) = 1
poste(3) = 1
co = 0
so = CInt(InputBox("INSERISCI LA SOMMA DEI 2 AMBI ISOTOPI",,40))
ii = InputBox("INSERISCI L'ESTRAZIONE DI PARTENZA",,9000)
kk = InputBox("INSERISCI I COLPI DI GIOCO",,13)
ini = ii
fin = EstrazioneFin
For es = ini To fin
AvanzamentoElab Ini,fin,es
Messaggio " " & DataEstrazione(es) & " '[ Ambi somma 90 isotopi °Metodo di ananda - Script By Blackmore°]"
For r1 = 1 To 9 ' la 1°ruota cerca la condizione da bari a venezia
For r2 = r1 + 1 To 10 ' la 2°ruota dalla successiva (della 1° ruota)fino alla nazionale
For r3 = r2 + 1 To 12
If r2 = 11 Then r2 = 12
For p1 = 1 To 4
For p2 = p1 + 1 To 5
a = Estratto(es,r1,p1)
b = Estratto(es,r1,p2)
c = Estratto(es,r2,p1)
d = Estratto(es,r2,p2)
e= Estratto(es,r3,p1)
f= Estratto(es,r3,p2)
If a + b = so Then
If c + d = so Then
If e + f = so Then
co = co + 1
casi = casi + 1
Scrivi String(110,"*") & " Caso n° " & Format2(casi),1
ColoreTesto 1
Scrivi DataEstrazione(es) & " - " & SiglaRuota(r1) & " - " & StringaEstratti(es,r1) & " - " & Format2(a) & "-" & Format2(b) & " = Somma " & so & " Isotopa",1
Scrivi DataEstrazione(es) & " - " & SiglaRuota(r2) & " - " & StringaEstratti(es,r2) & " - " & Format2(c) & "-" & Format2(d) & " = Somma " & so & " Isotopa",1
Scrivi DataEstrazione(es) & " - " & SiglaRuota(r3) & " - " & StringaEstratti(es,r3) & " - " & Format2(e) & "-" & Format2(f) & " = Somma " & so & " Isotopa",1

ColoreTesto 0
'ruote(1) = r1 : ruote(2) = r2
ruotee(1) = BA_ : ruotee(2) = PA_ :ruotee(3) = TU_
'ruota(4) = BA_ 'Se vuoi giocare gli ambi anche a tutte togli l'apice all'inizio della rig
n(1) = Figura(a)
n(2) = Figura(c)
n(3) = Fuori90(b - n(1) + d - Figura(c))
n(4) = Fuori90(Estratto(es,FI_ ,2)+0)
ImpostaGiocata 1,n,ruotee,poste,kk
Gioca es',1 ' se usate L8 o Lottodesk togliete la virgola e l'1 dopo gioca es
End If
End If
End If
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit For
Next
ScriviResoconto
End Sub

Gio.

 

[BEPPA51]

grazie tante

 

[roy]

Ciao Gio.sarebbe possibile mettere in automatico la ricerca di qualsiasi somma?,grazie,semplificherebbe tanto

 

[GioRyuKen72]

Ciao Gio.sarebbe possibile mettere in automatico la ricerca di qualsiasi somma?,grazie,semplificherebbe tanto

Ciao Roy, per quel poco che ne sò io, non ne sarei capace.. ?

 

[BEPPA51]

ciao Gio
il listato va bene
pero c è un problema,hò modiicato un listato di somma 90 isotopi che forse non era adato
xchè mi fa la somma con i numeri fino a 40.ti faccio un esempio 82+48 =130-90 =40 nn li conteggia.
comunque grazie ?

 

[GioRyuKen72]

Ciao Beppa, puoi ricercare entrambe le somme, prima la somma 40 e poi la somma 130.. o meglio ancora puoi usare la funzione Multi Script di Spaziometria inserendo lo stesso script per 2 volte.. una volta lanciati con il classico Fulmine, in uno metti somma 40 e nell'altro 130.. così hai i 2 listati pronti e puoi passare da uno all'altro, cliccandoci sopra..

Gio.

 

[BEPPA51]

ciao gio mi spiace non lo so fare

 

[salvo50]

Ciao Gio.sarebbe possibile mettere in automatico la ricerca di qualsiasi somma?,grazie,semplificherebbe tanto

Ciao a Tutti.

Ho modificato lo script del post 2, le somme uguali sono col fuori90, quindi ci sono anche quelle che superano 90, lo impostato per tutte le 90 somme, per questo motivo lo script è molto lento

Sub Main
   Dim ruote(10)
   Dim ruota(10)
   Dim ruotee(10)
   Dim n(10):Dim n1(10)
   Dim poste(3)
   Dim posta(1)
   'posta(1) = 1
   poste(2) = 1
   poste(3) = 1
   co = 0
   ii = InputBox("INSERISCI L'ESTRAZIONE DI PARTENZA",,9720)
   kk = InputBox("INSERISCI I COLPI DI GIOCO",,13)
   ini = ii
   fin = EstrazioneFin
   For es = ini To fin
      AvanzamentoElab Ini,fin,es
      'Messaggio " " & DataEstrazione(es) & " '[ Ambi somma 90 isotopi °Metodo di ananda - Script By Blackmore°]"
      For r1 = 1 To 9 '
         For r2 = r1 + 1 To 10 
            For r3 = r2 + 1 To 12
               If r2 = 11 Then r2 = 12
               For p1 = 1 To 4
                  For p2 = p1 + 1 To 5
                     a = Estratto(es,r1,p1)
                     b = Estratto(es,r1,p2)
                     c = Estratto(es,r2,p1)
                     d = Estratto(es,r2,p2)
                     e = Estratto(es,r3,p1)
                     f = Estratto(es,r3,p2)
                     For so = 1 To 90
                        ab = Fuori90(a + b)
                        cd = Fuori90(c + d)
                        ef = Fuori90(e + f)
                        If ab = so And cd = so And ef = so Then
                           co = co + 1
                           casi = casi + 1
                           Scrivi String(110,"*") & " Caso n° " & Format2(casi),1
                           ColoreTesto 1
                           Scrivi DataEstrazione(es) & " - " & SiglaRuota(r1) & " - " & StringaEstratti(es,r1) & " - " & Format2(a) & "-" & Format2(b) & " = Somma " & so & " Isotopa",1
                           Scrivi DataEstrazione(es) & " - " & SiglaRuota(r2) & " - " & StringaEstratti(es,r2) & " - " & Format2(c) & "-" & Format2(d) & " = Somma " & so & " Isotopa",1
                           Scrivi DataEstrazione(es) & " - " & SiglaRuota(r3) & " - " & StringaEstratti(es,r3) & " - " & Format2(e) & "-" & Format2(f) & " = Somma " & so & " Isotopa",1
                           ColoreTesto 0
                           'ruote(1) = r1 : ruote(2) = r2
                           ruotee(1) = BA_ : ruotee(2) = PA_ :ruotee(3) = TU_
                           'ruota(4) = BA_ 'Se vuoi giocare gli ambi anche a tutte togli l'apice all'inizio della rig
                           n(1) = Figura(a)
                           n(2) = Figura(c)
                           n(3) = Fuori90(b - n(1) + d - Figura(c))
                           n(4) = Fuori90(Estratto(es,FI_,2) + 0)
                           ImpostaGiocata 1,n,ruotee,poste,kk
                           Gioca es',1 ' se usate L8 o Lottodesk togliete la virgola e l'1 dopo gioca es
                        End If
                     Next
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub

 

[BEPPA51]

grazie salvo molto gentile è perfetto