ho fatto varie prove partendo dal concorso 9620 per 18 colpi ma salta estrazioni non le prende tutte nell'output dalla 9636 salta alla 9640 poi alla 9645 come mai le salta?
Grazie
Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp1,Salvo50,E1,E2,S1,S2,S3
Dim R1,R2,P1,P2,P3,P4,P5,P6,P7,A,B,C,D,E,Dist
Dim VertS3,CaS3,CaVertS3,Caso,Casi,X,Y,OK
Dim Posta(2),Ruote(2),Poste(5),Num(8),Nu(2)
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9500)
R1 = InputBox("INSERISCI IL NUMERO DELLA 1ª RUOTA",,1)
P1 = InputBox("INSERISCI IL 1° NUMERO DI POSIZIONE DELLA 1ª RUOTA",,1)
P2 = InputBox("INSERISCI IL 2° NUMERO DI POSIZIONE DELLA 1ª RUOTA",,2)
P3 = InputBox("INSERISCI IL 3° NUMERO DI POSIZIONE DELLA 1ª RUOTA",,3)
R2 = InputBox("INSERISCI IL NUMERO DELLA 2ª RUOTA",,2)
P4 = InputBox("INSERISCI IL 1° NUMERO DI POSIZIONE DELLA 2ª RUOTA",,1)
P5 = InputBox("INSERISCI IL 2° NUMERO DI POSIZIONE DELLA 2ª RUOTA",,5)
Dist = CInt(InputBox("QUALE DISTANZA VUOI CALCOLARE IN PIU' OPPURE MENO ",,1))
If R1 <> R2 And P1 <> P2 And P1 <> P3 And P2 <> P3 And P4 <> P5 Then
Clp1 = InputBox("Per quanti colpi vuoi giocare l'ottina?",,7)
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(12) & "PER BYRON - SCRIPT Salvo50",1,,4,,3,,1
Posta(1) = 1
Posta(2) = 1
Poste(2) = 1
Poste(3) = 1
'Poste(4) = 1
'Poste(5) = 1
Ruote(1) = R1
Ruote(2) = R2
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
OK = 0
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
C = Estratto(Es,R1,P3)
D = Estratto(Es,R2,P4)
E = Estratto(Es,R2,P5)
If A And D > 0 Then
S1 = Fuori90(A + B)
S2 = Fuori90(B + C)
S3 = Fuori90(S1 + S2)
VertS3 = Vert(S3)
CaS3 = Cadenza(S3)
CaVertS3 = Cadenza(VertS3)
If Not Gemello(S3) And Not Gemello(VertS3) And CaS3 <> 9 And CaVertS3 <> 9 Then
Nu(1) = S3 : Nu(2) = VertS3
If SerieFreqTurbo(Es,Es,Nu,Ruote,1) = 0 Then
Num(1) = S3
Num(2) = VertS3
Num(3) = Fuori90(90 +(D - Dist))
Num(4) = D
Num(5) = Fuori90(D + Dist)
Num(6) = Fuori90(90 +(E - Dist))
Num(7) = E
Num(8) = Fuori90(E + Dist)
OK = 1
If NumeriRipetuti(Num) Then OK = 0
If OK = 1 Then
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P6 = 1 To 5
E1 = Estratto(Es,R1,P6)
If E1 = A Or E1 = B Or E1 = C Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P7 = 1 To 5
E2 = Estratto(Es,R2,P7)
If E2 = D Or E2 = E Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(12) & " PIRAMIDE",1,,,2
Scrivi Space(12) & Format2(A) & " " & Format2(B) & " " & Format2(C),1
Scrivi Space(14) & Format2(S1) & " " & Format2(S2),1
Scrivi Space(16) & Format2(S3),1
Scrivi
ImpostaGiocata 1,Nu,Ruote,Posta,Clp1
ImpostaGiocata 2,Num,Ruote,Poste,Clp1
Gioca Es
End If
End If
End If
End If
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
End If
If R1 = R2 Then Scrivi " HAI INSERITO 2 RUOTE UGUALI ",1,,,2
If P1 = P2 Or P1 = P3 Or P2 = P3 Then Scrivi " HAI INSERITO 2 O PIU' POSIZIONI UGUALI NELLA 1ª RUOTA",1,,,2
If P4 = P5 Then Scrivi " HAI INSERITO 2 POSIZIONI UGUALI NELLA 2ª RUOTA",1,,,2
End Sub
Grazie
Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp1,Salvo50,E1,E2,S1,S2,S3
Dim R1,R2,P1,P2,P3,P4,P5,P6,P7,A,B,C,D,E,Dist
Dim VertS3,CaS3,CaVertS3,Caso,Casi,X,Y,OK
Dim Posta(2),Ruote(2),Poste(5),Num(8),Nu(2)
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9500)
R1 = InputBox("INSERISCI IL NUMERO DELLA 1ª RUOTA",,1)
P1 = InputBox("INSERISCI IL 1° NUMERO DI POSIZIONE DELLA 1ª RUOTA",,1)
P2 = InputBox("INSERISCI IL 2° NUMERO DI POSIZIONE DELLA 1ª RUOTA",,2)
P3 = InputBox("INSERISCI IL 3° NUMERO DI POSIZIONE DELLA 1ª RUOTA",,3)
R2 = InputBox("INSERISCI IL NUMERO DELLA 2ª RUOTA",,2)
P4 = InputBox("INSERISCI IL 1° NUMERO DI POSIZIONE DELLA 2ª RUOTA",,1)
P5 = InputBox("INSERISCI IL 2° NUMERO DI POSIZIONE DELLA 2ª RUOTA",,5)
Dist = CInt(InputBox("QUALE DISTANZA VUOI CALCOLARE IN PIU' OPPURE MENO ",,1))
If R1 <> R2 And P1 <> P2 And P1 <> P3 And P2 <> P3 And P4 <> P5 Then
Clp1 = InputBox("Per quanti colpi vuoi giocare l'ottina?",,7)
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(12) & "PER BYRON - SCRIPT Salvo50",1,,4,,3,,1
Posta(1) = 1
Posta(2) = 1
Poste(2) = 1
Poste(3) = 1
'Poste(4) = 1
'Poste(5) = 1
Ruote(1) = R1
Ruote(2) = R2
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
OK = 0
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
C = Estratto(Es,R1,P3)
D = Estratto(Es,R2,P4)
E = Estratto(Es,R2,P5)
If A And D > 0 Then
S1 = Fuori90(A + B)
S2 = Fuori90(B + C)
S3 = Fuori90(S1 + S2)
VertS3 = Vert(S3)
CaS3 = Cadenza(S3)
CaVertS3 = Cadenza(VertS3)
If Not Gemello(S3) And Not Gemello(VertS3) And CaS3 <> 9 And CaVertS3 <> 9 Then
Nu(1) = S3 : Nu(2) = VertS3
If SerieFreqTurbo(Es,Es,Nu,Ruote,1) = 0 Then
Num(1) = S3
Num(2) = VertS3
Num(3) = Fuori90(90 +(D - Dist))
Num(4) = D
Num(5) = Fuori90(D + Dist)
Num(6) = Fuori90(90 +(E - Dist))
Num(7) = E
Num(8) = Fuori90(E + Dist)
OK = 1
If NumeriRipetuti(Num) Then OK = 0
If OK = 1 Then
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P6 = 1 To 5
E1 = Estratto(Es,R1,P6)
If E1 = A Or E1 = B Or E1 = C Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P7 = 1 To 5
E2 = Estratto(Es,R2,P7)
If E2 = D Or E2 = E Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi
Scrivi Space(12) & " PIRAMIDE",1,,,2
Scrivi Space(12) & Format2(A) & " " & Format2(B) & " " & Format2(C),1
Scrivi Space(14) & Format2(S1) & " " & Format2(S2),1
Scrivi Space(16) & Format2(S3),1
Scrivi
ImpostaGiocata 1,Nu,Ruote,Posta,Clp1
ImpostaGiocata 2,Num,Ruote,Poste,Clp1
Gioca Es
End If
End If
End If
End If
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
End If
If R1 = R2 Then Scrivi " HAI INSERITO 2 RUOTE UGUALI ",1,,,2
If P1 = P2 Or P1 = P3 Or P2 = P3 Then Scrivi " HAI INSERITO 2 O PIU' POSIZIONI UGUALI NELLA 1ª RUOTA",1,,,2
If P4 = P5 Then Scrivi " HAI INSERITO 2 POSIZIONI UGUALI NELLA 2ª RUOTA",1,,,2
End Sub
Ultima modifica: