Novità

Probabile Bug ma non credo

S

sorujoe

Advanced Member >GOLD<
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
 
Ultima modifica:
Ciao Byron, salta le ambate e i vertibili con cadenza 9 e gemelli

ho tolto questi filtri, fammi sapere se salta ancora le estrazioni

Codice: 
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)
            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
         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
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 01 agosto 2026
    Bari
    46
    54
    36
    47
    01
    Cagliari
    77
    30
    04
    79
    18
    Firenze
    84
    76
    10
    27
    44
    Genova
    32
    13
    71
    38
    46
    Milano
    10
    23
    18
    20
    03
    Napoli
    73
    36
    10
    90
    07
    Palermo
    61
    46
    24
    57
    32
    Roma
    89
    78
    23
    07
    35
    Torino
    21
    59
    34
    73
    86
    Venezia
    74
    01
    30
    46
    54
    Nazionale
    71
    65
    17
    09
    20
    Estrazione Simbolotto
    Nazionale
    03
    09
    37
    30
    39
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto