Novità

Modifica per Salvo50

Si si è giusto li vedo pure io
se me lo implementi sulle somme distanze è ok in piu ti prego sull'ultimo script postato di togliermi il riscontro su tutte
 
Tolto riscontro su tutte, proseguo con modifiche sugli script SOMME e DISTANZE

Codice:
Option Explicit
Sub Main
   Dim Fig1,Fig2,Fig3,Fig4,FIn,Ini,Clp
   Dim R1,R2,P1,P2,P3,P4,P5,P6,Es,Caso,Casi
   Dim E1,E2,A,B,C,D,FA,FB,FC,FD,Sp,Sorte
   Dim RetEsito,RetColpi,RetEstratti,RetId
   Dim Ruote(2),Ru(2),Post(5)
   ReDim aNum1(10),aNum2(10)
   'Post(1) = 1
   Post(2) = 1
   Post(3) = 1
   'Post(4) = 1
   'Post(5) = 1
   Sp = " "
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9000)
   P1 = CInt(InputBox(" Indica la posizione del primo estratto della prima ruota",,1))
   Fig1 = CInt(InputBox(" Indica la figura che deve avere il primo estratto della prima ruota",,1))
   '
   P2 = CInt(InputBox(" Indica la posizione del secondo estratto della prima ruota",,3))
   Fig2 = CInt(InputBox(" Indica la figura che deve avere il secondo estratto della prima ruota",,2))
   '
   P3 = CInt(InputBox(" Indica la posizione del primo estratto della seconda ruota",,4))
   Fig3 = CInt(InputBox(" Indica la figura che deve avere il primo estratto della seconda ruota",,8))
   '
   P4 = CInt(InputBox(" Indica la posizione del secondo estratto della seconda ruota",,2))
   Fig4 = CInt(InputBox(" Indica la figura che deve avere il secondo estratto della seconda ruota",,7))
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare? ",,5))
   'Sorte = CInt(InputBox(" Per qualè sorte? 1 per Ambata, 2 per Ambo, ecc... ",,3))
   Call ScegliNumeri(aNum1)
   Call ScegliNumeri(aNum2)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(12) & " CHIESTO DA KUBES - SCELTA FIGURE E POSIZIONI ESTRATTI - SCRIPT SALVO50",1,,4,,3,,1
   For Es = Ini To FIn
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         A = Estratto(Es,R1,P1)
         B = Estratto(Es,R1,P2)
         FA = Figura(A) : FB = Figura(B)
         If Fig1 = FA And Fig2 = FB Then
            For R2 = R1 + 1 To 12
               C = Estratto(Es,R2,P3)
               D = Estratto(Es,R2,P4)
               FC = Figura(C) : FD = Figura(D)
               If Fig3 = FC And Fig4 = FD Then
                  Ru(1) = R1
                  Ru(2) = R2
                  'Ru(3) = TU_
                  Caso = Caso + 1
                  Casi = Casi + 1
                  Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
                  Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
                  Scrivi
                  Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                  Scrivi " " & SiglaRuota(R1) & " ",1,0
                  For P5 = 1 To 5
                     E1 = Estratto(Es,R1,P5)
                     If E1 = A Or E1 = B Then
                        ColoreTesto 2
                     Else
                        ColoreTesto 0
                     End If
                     Scrivi Format2(E1) & " ",1,0
                     ColoreTesto 0
                  Next
                  Scrivi " <--in Rosso Figure scelte " & FA & " " & FB,1
                  Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                  Scrivi " " & SiglaRuota(R2) & " ",1,0
                  For P6 = 1 To 5
                     E2 = Estratto(Es,R2,P6)
                     If E2 = C Or E2 = D Then
                        ColoreTesto 2
                     Else
                        ColoreTesto 0
                     End If
                     Scrivi Format2(E2) & " ",1,0
                     ColoreTesto 0
                  Next
                  Scrivi " <--in Rosso Figure scelte " & FC & " " & FD,1
                  Scrivi
                  Scrivi " Numeri scelti per 1ª Giocata " & StringaNumeri(aNum1,Sp,True),1,,,1
                  Scrivi " Numeri scelti per 2ª Giocata " & StringaNumeri(aNum2,Sp,True),1,,,2
                  Scrivi
                  ImpostaGiocata 1,aNum1,Ru,Post,Clp
                  ImpostaGiocata 2,aNum2,Ru,Post,Clp
                  Gioca Es,,,1
               End If
            Next
         End If
      Next
   Next
   ScriviResoconto
End Sub
 
Sono un mago con l'aiuto di Master

Questo è quello delle somme uguali, se va bene così, modifico anche quello delle distanze uguali


Option Explicit
Sub Main
Dim FIn,Es,Ini,Clp,Salvo50,K,G
Dim R1,R2,P1,P2,P3,P4,E1,E2,Caso,Casi
Dim Somma,A,B,C,D,Sorte,S1,S2,Idestr
Dim RetEsito,RetColpi,RetEstratti,RetId
Dim Ruo(2)
ReDim aNum(20)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9100))
Somma = CInt(InputBox("Inserisci la Somma comune da trovare",Salvo50,15))
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,18))
Call ScegliNumeri(aNum)
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(6) & "PER BYRON 2 SOMME UGUALI PER LUNGHETTA - SCRIPT SALVO50 con l'aiuto di MASTER",1,,4,,3,,1
For Es = Ini To FIn
Messaggio Es
AvanzamentoElab Ini,FIn,Es
Caso = 0
For R1 = 1 To 10
For P1 = 1 To 4
For P2 = P1 + 1 To 5
A = Estratto(Es,R1,P1)
B = Estratto(Es,R1,P2)
For R2 = R1 + 1 To 12
If R2 = 11 Then R2 = 12
C = Estratto(Es,R2,P1)
D = Estratto(Es,R2,P2)
S1 = Fuori90(A + B) : S2 = Fuori90(C + D)
If(S1 = S2 And S1 = Somma) Then
Ruo(1) = R1
Ruo(2) = R2
Caso = Caso + 1
Casi = Casi + 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,2
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,1
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P3 = 1 To 5
E1 = Estratto(Es,R1,P3)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi " <-- Rossi somma " & S1,1
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P4 = 1 To 5
E2 = Estratto(Es,R2,P4)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi " <-- Rossi somma " & S2,1
Scrivi
Scrivi " In gioco [ " & StringaNumeri(aNum) & " ]",1
Scrivi
K = 0
G = Es + Clp
If G > FIn Then G = FIn
For Idestr = Es + 1 To G
K = K + 1
Call VerificaEsito(aNum,Ruo,Idestr,1,1,Nothing,RetEsito,RetColpi,RetEstratti,RetId)
ColoreTesto 0
If RetEsito = "" Then Scrivi Idestr & " - " & Format2(K) & "° - " & Space(33) & " ESITO NON VERIFICATO ",1,,,1
If RetEsito <> "" Then
If RetEsito = "Ambo" Then ColoreTesto 2
If RetEsito = "Terno" Then ColoreTesto 1
If RetEsito = "Quaterna" Then ColoreTesto 7
If RetEsito = "Cinqina" Then ColoreTesto 3
Call Scrivi(Idestr & " - " & Format2(K) & "° - " & RetEstratti & " - " & RetEsito & " " & vbTab & GetInfoEstrazione(RetId),1)
ColoreTesto 0
End If
Next
Scrivi
End If
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
End Sub
 
Ultima modifica:
Distanze uguali

Codice:
Option Explicit
Sub Main
   Dim FIn,Es,Ini,Clp,Salvo50,K,G
   Dim R1,R2,P1,P2,P3,P4,E1,E2,Caso,Casi
   Dim Dist,A,B,C,D,Sorte,D1,D2,Idestr
   Dim RetEsito,RetColpi,RetEstratti,RetId
   Dim Ruo(2)
   ReDim aNum(20)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9100))
   Dist = CInt(InputBox("Inserisci la Distanza Ciclometrica da trovare",Salvo50,15))
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,18))
   Call ScegliNumeri(aNum)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi "PER BYRON 2 DISTANZE CICLOMETRICHE UGUALI PER LUNGHETTA - SCRIPT SALVO50 con l'aiuto di Master",1,,4,,3,,1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  C = Estratto(Es,R2,P1)
                  D = Estratto(Es,R2,P2)
                  D1 = Distanza(A,B) : D2 = Distanza(C,D)
                  If(D1 = D2 And D1 = Dist) Then
                     Ruo(1) = R1
                     Ruo(2) = R2
                     Caso = Caso + 1
                     Casi = Casi + 1
                     Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,2
                     Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,1
                     Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                     Scrivi " " & SiglaRuota(R1) & " ",1,0
                     For P3 = 1 To 5
                        E1 = Estratto(Es,R1,P3)
                        If E1 = A Or E1 = B Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi "  <-- Rossi Distanza " & D1,1
                     Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                     Scrivi " " & SiglaRuota(R2) & " ",1,0
                     For P4 = 1 To 5
                        E2 = Estratto(Es,R2,P4)
                        If E2 = C Or E2 = D Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E2) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi "  <-- Rossi Distanza " & D2,1
                     Scrivi
                     Scrivi " In gioco [ " & StringaNumeri(aNum) & " ]",1
                     Scrivi
                     K = 0 : G = 0
                     G = Es + Clp
                     If G > FIn Then G = FIn
                     For Idestr = Es + 1 To G
                        K = K + 1
                        Call VerificaEsito(aNum,Ruo,Idestr,1,1,Nothing,RetEsito,RetColpi,RetEstratti,RetId)
                        ColoreTesto 0
                        If RetEsito = "" Then Scrivi Idestr & " - " & Format2(K) & "°  - " & Space(30) & " ESITO NON VERIFICATO ",1,,,1
                        If RetEsito <> "" Then
                           If RetEsito = "Ambo" Then ColoreTesto 2
                           If RetEsito = "Terno" Then ColoreTesto 1
                           If RetEsito = "Quaterna" Then ColoreTesto 7
                           If RetEsito = "Cinqina" Then ColoreTesto 3
                           Call Scrivi(Idestr & " - " & Format2(K) & "°  - " & RetEstratti & " - " & RetEsito & "  " & vbTab & GetInfoEstrazione(RetId),1)
                           ColoreTesto 0
                        End If
                     Next
                  End If
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
End Sub
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 14 gennaio 2025
    Bari
    41
    25
    12
    73
    55
    Cagliari
    54
    20
    48
    32
    67
    Firenze
    75
    23
    68
    10
    38
    Genova
    33
    27
    81
    70
    64
    Milano
    68
    01
    64
    86
    87
    Napoli
    47
    75
    45
    10
    21
    Palermo
    55
    86
    33
    53
    70
    Roma
    88
    78
    61
    06
    07
    Torino
    76
    08
    23
    61
    82
    Venezia
    25
    15
    49
    21
    81
    Nazionale
    70
    10
    32
    78
    07
    Estrazione Simbolotto
    Bari
    07
    14
    28
    45
    31

Ultimi Messaggi

Indietro
Alto