Novità

Da Un Suggerimento Di Tascione "Raccolta Script con Cerchio Ciclometrico"

'https://forum.lottoced.com/threads/script-su-metodi-cabalistici-ciclometrici-c.2089682/page-40
Metodo il Trapezio con ambi uniti e isotopi di Domenico Manna
Codice:
Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,Clp,Es,Cer
   Dim R1,R2,P1,P2,Salvo50
   Dim SoAB,SoCD
   Dim DM12,DM23,DM34,DM41,Caso,Casi
   Dim Ambo1(2),Ambo2(2),Ambo3(2),Ruo(3)
   Dim Posta(2),L(6),M(4)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9000))'L'estrazione 5739 esempio nelle spiegazioni
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi "Metodo il Trapezio con ambi uniti e isotopi di Domenico Manna - Script Salvo50" & Space(5),1,,4,,3,,1
   Posta(2) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 4
            P2 = P1 + 1
            A = Estratto(Es,R1,P1)
            B = Estratto(Es,R1,P2)
            SoAB = Fuori90(A + B)
            For R2 = R1 + 1 To 12
               If R2 = 11 Then R2 = 12
               C = Estratto(Es,R2,P1)
               D = Estratto(Es,R2,P2)
               SoCD = Fuori90(C + D)
               If A > 0 And C > 0 And SoAB = SoCD Then
                  If A <> C And A <> D And B <> C And B <> D Then
                     M(1) = A : M(2) = B : M(3) = C : M(4) = D
                     Call OrdinaMatrice(M,1)
                     DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
                     DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
                     If DM12 = 27 And DM23 = 20 And DM34 = 27 And DM41 = 16 _
                        Or DM12 = 20 And DM23 = 27 And DM34 = 16 And DM41 = 27_
                        Or DM12 = 27 And DM23 = 16 And DM34 = 27 And DM41 = 20_
                        Or DM12 = 16 And DM23 = 27 And DM34 = 20 And DM41 = 27 Then
                        '---------------------------------
                        If DM12 = 27 And DM23 = 20 And DM34 = 27 And DM41 = 16 Then
                           L(5) = Fuori90(M(2) + 16) : L(6) = Fuori90(L(5) + 2)
                           Ambo1(1) = Fuori90(M(2) + 16)
                           Ambo2(1) = Fuori90(M(2) + 2)
                           Ambo3(1) = Fuori90(M(2) + 2)
                        End If
                        If DM12 = 20 And DM23 = 27 And DM34 = 16 And DM41 = 27 Then
                           L(5) = Fuori90(M(1) + 16) : L(6) = Fuori90(L(5) + 2)
                           Ambo1(1) = Fuori90(M(1) + 16)
                           Ambo2(1) = Fuori90(M(1) + 2)
                           Ambo3(1) = Fuori90(M(1) + 2)
                           '
                        End If
                        If DM12 = 27 And DM23 = 16 And DM34 = 27 And DM41 = 20 Then
                           L(5) = Fuori90(M(4) + 16) : L(6) = Fuori90(L(5) + 2)
                           Ambo1(1) = Fuori90(M(4) + 16)
                           Ambo2(1) = Fuori90(M(4) + 2)
                           Ambo3(1) = Fuori90(M(4) + 2)
                        End If
                        If DM12 = 16 And DM23 = 27 And DM34 = 20 And DM41 = 27 Then
                           L(5) = Fuori90(M(3) + 16) : L(6) = Fuori90(L(5) + 2)
                           Ambo1(1) = Fuori90(M(3) + 16)
                           Ambo2(1) = Fuori90(M(3) + 2)
                           Ambo3(1) = Fuori90(M(3) + 2)
                        End If
                        Ambo1(2) = Fuori90(Ambo1(1) + 2)
                        Ambo2(2) = Fuori90(Ambo2(1) + 2)
                        Ambo3(2) = Fuori90(Ambo2(1) + 16)
                        L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
                        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
                        ReDim MatrCasella(4,1)
                        MatrCasella(1,0) = R1
                        MatrCasella(1,1) = P1
                        MatrCasella(2,0) = R1
                        MatrCasella(2,1) = P2
                        MatrCasella(3,0) = R2
                        MatrCasella(3,1) = P1
                        MatrCasella(4,0) = R2
                        MatrCasella(4,1) = P2
                        Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
                        Scrivi
                        Scrivi Space(10) & " La Somma Uguale è " & Format2(SoAB),1
                       Scrivi
                        If Cer = 1 Then
                           DisegnaCerchioCiclometrico M,1,1,,,1,1
                           DisegnaCerchioCiclometrico L,1,1,,,1,1
                        End If
                        Scrivi
                        Ruo(1) = R1 : Ruo(2) = R2 : Ruo(3) = TT_
                        ImpostaGiocata 1,Ambo1,Ruo,Posta,Clp
                        ImpostaGiocata 2,Ambo2,Ruo,Posta,Clp
                        ImpostaGiocata 3,Ambo3,Ruo,Posta,Clp
                        Gioca Es,1
                        '
                     End If
                  End If
               End If
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi " Tempo Trascorso" & TempoTrascorso
End Sub
 
Come Vincere la Quaterna a Ruota di Franco Mongillo

Codice:
'https://forum.lottoced.com/threads/script-su-metodi-cabalistici-ciclometrici-c.2089682/page-22
Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,Clp,K,Es,Cer,Salvo50,X1,X2
   Dim R1,R2,P1,P2,P3,P4,P5,P6,E1,E2,Caso,Casi
   Dim SM14,SM23,DM12,DM43,DM13,DM24,DM14,DM23
   Dim DeX1,DeX2,CaX1,CaX2,Diff1,Abb1,Abb2,Abb3,Abb4
   Dim Amba(1),Penta(5),L(6),M(4),M1(2),Q(6)
   Dim Ruo(2),Ruot(3),Po1(1),Po2(5),Po3(5)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10640)) '7613 - 7663 esempi nell'articolo
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(8) & "Come Vincere La Quaterna a Ruota - Franco Mongillo - Script Salvo50" & Space(9),1,,4,,3,,1
   Scrivi Space(22) & "Con interruzione giocate alla prima uscita" & Space(20),1,,4,,3,,1
   Po1(1) = 1
   Po2(2) = 1
   Po2(3) = 1
   Po2(4) = 1
   Po3(2) = 1
   Po3(3) = 1
   Po3(4) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 9
         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 10
                  C = Estratto(Es,R2,P1)
                  D = Estratto(Es,R2,P2)
                  If A > 0 And C > 0 Then
                     If A <> C And A <> D And B <> C And B <> D Then
                        M(1) = A : M(2) = B : M(3) = C : M(4) = D
                        Call OrdinaMatrice(M,1)
                        'M1--M2
                        '|   |
                        'M4--M3
                        DM12 = Distanza(M(1),M(2)) : DM43 = Distanza(M(4),M(3))' Distanza orizzontale estratti
                        DM13 = Distanza(M(1),M(3)) : DM24 = Distanza(M(2),M(4))' Distanza diagonale estratti
                        SM14 = Fuori90(M(1) + M(4)) : SM23 = Fuori90(M(2) + M(3))'somma verticale estratti
                        If(DM12 = DM43)And(DM13 = DM24)And SM14 = SM23 Then ' Uguaglianza distanze e somme
                           DM14 = Distanza(M(1),M(4)) : DM23 = Distanza(M(2),M(3)) ' distanza verticale
                           M1(1) = DM23 : M1(2) = DM14
                           Call OrdinaMatrice(M1,1)
                           'BASE MAGGIORE E MINORE DISPARI
                           If dispari(M1(1)) And dispari(M1(2)) Then
                              X1 = Fuori90((90 + M(1)) - DM12)
                              X2 = Fuori90(M(4) + DM43)
                              DeX1 = Decina(X1) : CaX1 = Cadenza(X1)
                              DeX2 = Decina(X2) : CaX2 = Cadenza(X2)
                              Abb1 = DeX2 & CaX1 : Abb2 = DeX1 & CaX2
                              Abb1 = Fuori90(Abb1) : Abb2 = Fuori90(Abb2)
                              Diff1 = Differenza(Abb1,Abb2)
                              Diff1 = Diametrale(Diff1)
                              Abb3 = CaX1 & DeX2 : Abb4 = CaX2 & DeX1
                              Abb3 = Fuori90(Abb3) : Abb4 = Fuori90(Abb4)
                              Amba(1) = Diff1
                              Penta(1) = Diff1 : Penta(2) = Abb1 : Penta(3) = Abb2 : Penta(4) = Abb3 : Penta(5) = Abb4
                              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 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
                              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
                              Scrivi Space(13) & " BASE MAGGIORE E MINORE DISPARI",1,,,1
                              Scrivi Space(7) & "Estratti " & Space(4) & "Differenze " & Space(6) & "Somme ",1,0
                              Scrivi Space(7) & "Differenze ",1
                              Scrivi Space(7) & " Validi  " & Space(4) & "Orizzontali" & Space(5),1,0
                              Scrivi "Verticali     Diagonali",1
                              Scrivi Space(8) & Format2(M(1)) & " " & Format2(M(2)) & Space(11) & Format2(DM12),1,0
                              Scrivi Space(13) & Format2(SM14) & Space(12) & Format2(DM13),1
                              Scrivi Space(8) & Format2(M(4)) & " " & Format2(M(3)) & Space(11) & Format2(DM43),1,0
                              Scrivi Space(13) & Format2(SM23) & Space(12) & Format2(DM24),1
                              Scrivi
                              If Cer = 1 Then
                                 L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4) : L(5) = X1 : L(6) = X2
                                 DisegnaCerchioCiclometrico L,1,,,,1
                              End If
                              Scrivi
                              Ruo(1) = R1 : Ruo(2) = R2
                              Ruot(1) = TU_
                              ImpostaGiocata 1,Amba,Ruo,Po1,Clp,1
                              EliminaRipetuti Penta
                              ImpostaGiocata 2,Penta,Ruo,Po2,Clp,2
                              ImpostaGiocata 3,Penta,Ruot,Po3,Clp,2
                              For K = 1 To 3
                                 ImpostaInterruzioni K,1,1
                                 ImpostaInterruzioni K,2,2
                                 ImpostaInterruzioni K,3,2
                              Next
                              Gioca Es,,,1
                           End If
                        End If
                     End If
                  End If
               Next
            Next
            'Next
         Next
         If ScriptInterrotto Then Exit Sub
      Next
      For R1 = 1 To 9
         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 10
                  C = Estratto(Es,R2,P1)
                  D = Estratto(Es,R2,P2)
                  If A > 0 And C > 0 Then
                     If A <> C And A <> D And B <> C And B <> D Then
                        M(1) = A : M(2) = B : M(3) = C : M(4) = D
                        Call OrdinaMatrice(M,1)
                        'M1--M2
                        '|   |
                        'M4--M3
                        DM12 = Distanza(A,B) : DM43 = Distanza(C,D)' Distanza orizzontale estratti
                        DM13 = Distanza(A,D) : DM24 = Distanza(C,B)' Distanza diagonale estratti
                        SM14 = Fuori90(A + C) : SM23 = Fuori90(B + D)'somma verticale estratti
                        If(DM12 = DM43)And(DM13 = DM24)And SM14 = SM23 Then ' Uguaglianza distanze e somme
                           DM14 = Distanza(A,C) : DM23 = Distanza(B,D) ' distanza verticale
                           M1(1) = DM23 : M1(2) = DM14
                           Call OrdinaMatrice(M1,1)
                           'BASE MAGGIORE E MINORE PARI
                           If pari(M1(1)) And pari(M1(2)) Then
                              X1 = M1(2) \ 2 : X1 = Fuori90(X1 + C)
                              X2 = M1(1) \ 2 : X2 = Fuori90(X2 + B)
                              DeX1 = Decina(X1) : CaX1 = Cadenza(X1)
                              DeX2 = Decina(X2) : CaX2 = Cadenza(X2)
                              Abb1 = DeX2 & CaX1 : Abb2 = DeX1 & CaX2
                              Abb1 = Fuori90(Abb1) : Abb2 = Fuori90(Abb2)
                              Diff1 = Differenza(Abb1,Abb2)
                              Diff1 = Diametrale(Diff1)
                              Abb3 = CaX1 & DeX1 : Abb4 = CaX2 & DeX2
                              Abb3 = Fuori90(Abb3) : Abb4 = Fuori90(Abb4)
                              Amba(1) = Diff1
                              Penta(1) = Diff1 : Penta(2) = Abb1 : Penta(3) = Abb2 : Penta(4) = Abb3 : Penta(5) = Abb4
                              Q(1) = A : Q(2) = B : Q(3) = C : Q(4) = D : Q(5) = X1 : Q(6) = X2
                              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 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
                              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
                              Scrivi Space(13) & " BASE MAGGIORE E MINORE PARI",1,,,2
                              Scrivi Space(7) & "Estratti " & Space(4) & "Differenze " & Space(6) & "Somme ",1,0
                              Scrivi Space(7) & "Differenze ",1
                              Scrivi Space(7) & " Validi  " & Space(4) & "Orizzontali" & Space(5),1,0
                              Scrivi "Verticali     Diagonali",1
                              Scrivi Space(8) & Format2(M(1)) & " " & Format2(M(2)) & Space(11) & Format2(DM12),1,0
                              Scrivi Space(13) & Format2(SM14) & Space(12) & Format2(DM13),1
                              Scrivi Space(8) & Format2(M(4)) & " " & Format2(M(3)) & Space(11) & Format2(DM43),1,0
                              Scrivi Space(13) & Format2(SM23) & Space(12) & Format2(DM24),1
                              Scrivi
                              If Cer = 1 Then
                                 DisegnaCerchioCiclometrico Q,1,,,,1
                              End If
                              Scrivi
                              Ruo(1) = R1 : Ruo(2) = R2
                              Ruot(1) = TU_
                              ImpostaGiocata 1,Amba,Ruo,Po1,Clp,1
                              EliminaRipetuti Penta
                              ImpostaGiocata 2,Penta,Ruo,Po2,Clp,2
                              ImpostaGiocata 3,Penta,Ruot,Po3,Clp,2
                              For K = 1 To 3
                                 ImpostaInterruzioni K,1,1
                                 ImpostaInterruzioni K,2,2
                                 ImpostaInterruzioni K,3,2
                              Next
                              Gioca Es,,,1
                           End If
                        End If
                     End If
                  End If
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi "Tempo Trascorso" & TempoTrascorso,1
End Sub
 
Ciao a Tutti
Qualche script è un po' datato e prima di postarlo lo sto migliorando, come questo

Somma Pari

Codice:
Option Explicit
Dim R1,P1,P2,P3,Es,Es1,Clp,Caso,Casi,fin,Ini
Dim E1,E2,E3,E4,Di12,Di13,Di34,Di24,Ka,E,K,K2
Dim Ru(2),Poste(2),Amb(3),A(4)
Sub Main
   'poste(1) = 1
   Poste(2) = 1
   fin = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,10665)
   Clp = CInt(InputBox("Per quanti colpi vuoi fare la ricerca",,15))
   Scrivi Space(15) & " Progetto Somma Pari - Script Salvo50" & Space(15),1,,4,,3,,1
   For Es = Ini To fin
      Messaggio(Es)
      AvanzamentoElab Ini,fin,Es
      Caso = 0
      For R1 = 1 To 10
         Ru(1) = R1
         Ru(2) = TT_
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               E1 = Estratto(Es,R1,P1)
               E2 = Estratto(Es,R1,P2)
               E = E1 + E2
               If pari(E) Then
                  E3 = E / 2
                  Di12 = Distanza(E1,E2)
                  Di13 = Distanza(E1,E3)
                  E4 = Fuori90(E3 + Di12)
                  Di34 = Distanza(E3,E4)
                  Di24 = Distanza(E2,E4)
                  If Distanza(E1,E3) = Distanza(E2,E4) Then
                     If Distanza(E1,E2) = Distanza(E3,E4) Then
                        A(1) = E1
                        A(2) = E2
                        A(3) = E3
                        A(4) = E4
                        uscite
                        DisegnaCerchioCiclometrico A,- 1,1,,,1,1
                        Amb(1) = E4
                        Amb(2) = Di24
                        Amb(3) = Di34
                        ImpostaGiocata 1,Amb,Ru,Poste,Clp
                        Gioca Es
                     End If
                  End If
               End If
            Next
         Next
      Next
   Next
   ScriviResoconto
End Sub
Function uscite
   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
      K2 = Estratto(Es,R1,P3)
      If K2 = E1 Or K2 = E2 Then
         ColoreTesto 2
      Else
         ColoreTesto 0
      End If
      Scrivi Format2(K2) & " ",1,0
      ColoreTesto 0
   Next
   Scrivi " Evidenziati Somma Pari " & Format2(E),1
   Scrivi
   Scrivi " " & Format2(E1) & " " & Format2(Di12) & " " & Format2(E2)
   Scrivi " " & Format2(Di13) & "    " & Format2(Di24)
   Scrivi " " & Format2(E3) & " " & Format2(Di34) & " " & Format2(E4)
   Scrivi
   ColoreTesto 0
End Function
 
Ciao a Tutti

I Due Ambi Magnifici - Mod 22 - di Angelo Gargiulo

Codice:
Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,Clp1,Clp2,Es,Cer,Salvo50
   Dim R1,R2,R3,P1,P2,P3,P4,P7,P8,E1,E2,Caso,Casi
   Dim DM12,DM23,DM34,DM41,Ch1,Ch2,Ch3,Ch4
   Dim L(6),M(4),N(8)
   Dim Ambata(1),Ambo1(2),Ambo2(2),Terno(3)
   Dim Ruo1(2),Ruo2(4),Poste1(1),Poste2(2),Poste3(3)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10625))'9627 esempio nell'articolo
   Clp1 = CInt(InputBox(" Per quanti colpi vuoi giocare l'ambata?",Salvo50,5))
   Clp2 = CInt(InputBox(" Per quanti colpi vuoi giocare gli ambi e il terno?",Salvo50,10))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   'Call ScegliRange(Ini,FIn,Ini,FIn) '10220
   Scrivi Space(9) & "I Due Ambi Magnifici di Angelo Gargiulo - Mod. 22 - Script Salvo50" & Space(9),1,,4,,3,,1
   Poste1(1) = 1
   Poste2(2) = 1
   Poste3(2) = 1
   Poste3(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
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        C = Estratto(Es,R2,P3)
                        D = Estratto(Es,R2,P4)
                        If A > 0 And C > 0 Then
                           If A <> C And A <> D And B <> C And B <> D Then
                              M(1) = A : M(2) = B : M(3) = C : M(4) = D
                              Call OrdinaMatrice(M,1)
                              'M1--M2
                              '|   |
                              'M4--M3
                              DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
                              DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
                              If DM12 = 9 And DM23 = 27 And DM34 = 18 And DM41 = 36 _
                                 Or DM12 = 27 And DM23 = 18 And DM34 = 36 And DM41 = 9 _
                                 Or DM12 = 18 And DM23 = 36 And DM34 = 9 And DM41 = 27 _
                                 Or DM12 = 36 And DM23 = 9 And DM34 = 27 And DM41 = 18 Then
                                 '---------------------------------
                                 If DM12 = 9 And DM23 = 27 And DM34 = 18 And DM41 = 36 Then
                                    Ch1 = Fuori90(M(3) + 9)
                                    Ch2 = Fuori90(M(4) + 9)
                                    Ch3 = Fuori90(M(4) + 27)
                                    Ch4 = Fuori90(M(2) + 9)
                                 End If
                                 If DM12 = 27 And DM23 = 18 And DM34 = 36 And DM41 = 9 Then
                                    Ch1 = Fuori90(M(2) + 9)
                                    Ch2 = Fuori90(M(3) + 9)
                                    Ch3 = Fuori90(M(3) + 27)
                                    Ch4 = Fuori90(M(1) + 9)
                                 End If
                                 If DM12 = 18 And DM23 = 36 And DM34 = 9 And DM41 = 27 Then
                                    Ch1 = Fuori90(M(1) + 9)
                                    Ch2 = Fuori90(M(2) + 9)
                                    Ch3 = Fuori90(M(2) + 27)
                                    Ch4 = Fuori90(M(4) + 9)
                                 End If
                                 If DM12 = 36 And DM23 = 9 And DM34 = 27 And DM41 = 18 Then
                                    Ch1 = Fuori90(M(4) + 9)
                                    Ch2 = Fuori90(M(1) + 9)
                                    Ch3 = Fuori90(M(1) + 27)
                                    Ch4 = Fuori90(M(3) + 9)
                                 End If
                                 Ambata(1) = Ch1
                                 Ambo1(1) = Ch1 : Ambo1(2) = Ch3
                                 Ambo2(1) = Ch1 : Ambo2(2) = Ch4
                                 Terno(1) = Ch1 : Terno(2) = Ch3 : Terno(3) = Ch4
                                 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 P7 = 1 To 5
                                    E1 = Estratto(Es,R1,P7)
                                    If E1 = A Or E1 = B 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 P8 = 1 To 5
                                    E2 = Estratto(Es,R2,P8)
                                    If E2 = C Or E2 = D Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E2) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi
                                 If Cer = 1 Then
                                    DisegnaCerchioCiclometrico M,1,1,,,1,1
                                    L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4) : L(5) = Ch1 : L(6) = Ch2
                                    DisegnaCerchioCiclometrico L,1,1,,,1,1
                                    N(1) = M(1) : N(2) = M(2) : N(3) = M(3) : N(4) = M(4)
                                    N(5) = Ch1 : N(6) = Ch2 : N(7) = Ch3 : N(8) = Ch4
                                    DisegnaCerchioCiclometrico N,1,1,,,1,1
                                 End If
                                 Scrivi
                                 Ruo1(1) = R1 : Ruo1(2) = R2
                                 Ruo2(1) = R1 : Ruo2(2) = R2 : Ruo2(3) = NZ_ : Ruo2(4) = TT_
                                 ImpostaGiocata 1,Ambata,Ruo1,Poste1,Clp1
                                 ImpostaGiocata 2,Ambo1,Ruo2,Poste2,Clp2
                                 ImpostaGiocata 3,Ambo2,Ruo2,Poste2,Clp2
                                 ImpostaGiocata 4,Terno,Ruo2,Poste3,Clp2
                                 Gioca Es,1
                              End If
                           End If
                        End If
                        If ScriptInterrotto Then Exit Sub
                     Next
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi " Tempo Trascorso " & TempoTrascorso
End Sub


I Due Ambi Magnifici - Mod 13 - di Angelo Gargiulo

Codice:
Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,Clp1,Clp2,Es,Cer,Salvo50
   Dim R1,R2,R3,P1,P2,P3,P4,P7,P8,E1,E2,Caso,Casi
   Dim DM12,DM23,DM34,DM41,Ch1,Ch2,Ch3,Ch4
   Dim L(6),M(4),N(8)
   Dim Ambata(1),Ambo1(2),Ambo2(2),Terno(3)
   Dim Ruo1(2),Ruo2(4),Poste1(1),Poste2(2),Poste3(3)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10643))'9627 esempio nell'articolo
   Clp1 = CInt(InputBox(" Per quanti colpi vuoi giocare l'ambata?",Salvo50,5))
   Clp2 = CInt(InputBox(" Per quanti colpi vuoi giocare gli ambi e il terno?",Salvo50,10))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   'Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(9) & "I Due Ambi Magnifici di Angelo Gargiulo - Mod. 13 - Script Salvo50" & Space(9),1,,4,,3,,1
   Poste1(1) = 1
   Poste2(2) = 1
   Poste3(2) = 1
   Poste3(3) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 12
         If R1 = 11 Then R1 = 12
         For P1 = 1 To 5
            A = Estratto(Es,R1,P1)
            For R2 = 1 To 12
               If R2 = 11 Then R2 = 12
               If R1 <> R2 Then
                  For P2 = 1 To 3
                     For P3 = P2 + 1 To 4
                        For P4 = P3 + 1 To 5
                           B = Estratto(Es,R2,P2)
                           C = Estratto(Es,R2,P3)
                           D = Estratto(Es,R2,P4)
                           If A > 0 And B > 0 Then
                              If A <> B And A <> C And A <> D Then
                                 M(1) = A : M(2) = B : M(3) = C : M(4) = D
                                 Call OrdinaMatrice(M,1)
                                 'M1--M2
                                 '|   |
                                 'M4--M3
                                 DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
                                 DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
                                 If DM12 = 9 And DM23 = 27 And DM34 = 18 And DM41 = 36 _
                                    Or DM12 = 27 And DM23 = 18 And DM34 = 36 And DM41 = 9 _
                                    Or DM12 = 18 And DM23 = 36 And DM34 = 9 And DM41 = 27 _
                                    Or DM12 = 36 And DM23 = 9 And DM34 = 27 And DM41 = 18 Then
                                    '---------------------------------
                                    If DM12 = 9 And DM23 = 27 And DM34 = 18 And DM41 = 36 Then
                                       Ch1 = Fuori90(M(3) + 9)
                                       Ch2 = Fuori90(M(4) + 9)
                                       Ch3 = Fuori90(M(4) + 27)
                                       Ch4 = Fuori90(M(2) + 9)
                                    End If
                                    If DM12 = 27 And DM23 = 18 And DM34 = 36 And DM41 = 9 Then
                                       Ch1 = Fuori90(M(2) + 9)
                                       Ch2 = Fuori90(M(3) + 9)
                                       Ch3 = Fuori90(M(3) + 27)
                                       Ch4 = Fuori90(M(1) + 9)
                                    End If
                                    If DM12 = 18 And DM23 = 36 And DM34 = 9 And DM41 = 27 Then
                                       Ch1 = Fuori90(M(1) + 9)
                                       Ch2 = Fuori90(M(2) + 9)
                                       Ch3 = Fuori90(M(2) + 27)
                                       Ch4 = Fuori90(M(4) + 9)
                                    End If
                                    If DM12 = 36 And DM23 = 9 And DM34 = 27 And DM41 = 18 Then
                                       Ch1 = Fuori90(M(4) + 9)
                                       Ch2 = Fuori90(M(1) + 9)
                                       Ch3 = Fuori90(M(1) + 27)
                                       Ch4 = Fuori90(M(3) + 9)
                                    End If
                                    Ambata(1) = Ch1
                                    Ambo1(1) = Ch1 : Ambo1(2) = Ch3
                                    Ambo2(1) = Ch1 : Ambo2(2) = Ch4
                                    Terno(1) = Ch1 : Terno(2) = Ch3 : Terno(3) = Ch4
                                    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 P7 = 1 To 5
                                       E1 = Estratto(Es,R1,P7)
                                       If E1 = A 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 P8 = 1 To 5
                                       E2 = Estratto(Es,R2,P8)
                                       If E2 = B Or E2 = C Or E2 = D Then
                                          ColoreTesto 2
                                       Else
                                          ColoreTesto 0
                                       End If
                                       Scrivi Format2(E2) & " ",1,0
                                       ColoreTesto 0
                                    Next
                                    Scrivi
                                    If Cer = 1 Then
                                       DisegnaCerchioCiclometrico M,1,1,,,1,1
                                       L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4) : L(5) = Ch1 : L(6) = Ch2
                                       DisegnaCerchioCiclometrico L,1,1,,,1,1
                                       N(1) = M(1) : N(2) = M(2) : N(3) = M(3) : N(4) = M(4)
                                       N(5) = Ch1 : N(6) = Ch2 : N(7) = Ch3 : N(8) = Ch4
                                       DisegnaCerchioCiclometrico N,1,1,,,1,1
                                    End If
                                    Scrivi
                                    Ruo1(1) = R1 : Ruo1(2) = R2
                                    Ruo2(1) = R1 : Ruo2(2) = R2 : Ruo2(3) = NZ_ : Ruo2(4) = TT_
                                    ImpostaGiocata 1,Ambata,Ruo1,Poste1,Clp1
                                    ImpostaGiocata 2,Ambo1,Ruo2,Poste2,Clp2
                                    ImpostaGiocata 3,Ambo2,Ruo2,Poste2,Clp2
                                    ImpostaGiocata 4,Terno,Ruo2,Poste3,Clp2
                                    Gioca Es,1
                                 End If
                              End If
                           End If
                        Next
                     Next
                  Next
               End If
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi " Tempo Trascorso " & TempoTrascorso
End Sub
 
Ciao a Tutti

La riproduzione Numerica (stessa estrazione)

'https://forum.lottoced.com/threads/script.2218289/

Codice:
Option Explicit
Sub Main
   Dim FIn,Es,Es2,Es3,Ini,Clp1,Salvo50,E1,E2,R1,R2,R3,E3,Sp
   Dim Caso,Casi,P1,P2,P3,P4,P5,P6,P7,P8,P9,A,B,C,D,E,F,G
   Dim Somma1,Somma2,Somma3,Clp2,Vis,X
   Dim Ruo(3),Posta(1),Poste(2),Amba(1),Num(6),Ambo(2)
   Posta(1) = 1
   Poste(2) = 1
   Sp = " "
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10160))
   Clp1 = CInt(InputBox("Per quanti colpi vuoi giocare l'ambata?",,5))
   Clp2 = CInt(InputBox("Per quanti colpi vuoi giocare gli ambi?",,15))
   Vis = CInt(InputBox("Vuoi Visualizzare I Cerchi Ciclometrici? Per SI Metti 1 per NO, Metti un Altro Numero",,1))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(12) & " La Riproduzione Numerica - Postato da ScarfaceTony - Script Salvo50",1,,4,,3,,1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 9
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               Somma1 = Fuori90(A + B)
               For R2 = R1 + 1 To 10
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        C = Estratto(Es,R2,P3)
                        D = Estratto(Es,R2,P4)
                        Somma2 = Fuori90(C + D)
                        If Somma1 = Somma2 Then
                           For R3 = R2 + 1 To 12
                              If R3 = 11 Then R3 = 12
                              For P5 = 1 To 4
                                 For P6 = P5 + 1 To 5
                                    E = Estratto(Es,R3,P5)
                                    F = Estratto(Es,R3,P6)
                                    Somma3 = Fuori90(E + F)
                                    If Somma2 = Somma3 Then
                                       Num(1) = A : Num(2) = B : Num(3) = C
                                       Num(4) = D : Num(5) = E : Num(6) = F
                                       Call OrdinaMatrice(Num,1)
                                       If(Distanza(Num(1),Num(2)) = 15) And(Distanza(Num(2),Num(3)) = 15)_
                                          And(Distanza(Num(3),Num(4)) = 15) And(Distanza(Num(4),Num(5)) = 15)_
                                          And(Distanza(Num(5),Num(6)) = 15) Then
                                          Amba(1) = F
                                          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 P7 = 1 To 5
                                             E1 = Estratto(Es,R1,P7)
                                             If E1 = A Or E1 = B Then
                                                ColoreTesto 2
                                             Else
                                                ColoreTesto 0
                                             End If
                                             Scrivi Format2(E1) & " ",1,0
                                             ColoreTesto 0
                                          Next
                                          Scrivi "  Somma Evidenziati = " & Format2(Somma1),1
                                          Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                          Scrivi "  " & SiglaRuota(R2) & " ",1,0
                                          For P8 = 1 To 5
                                             E2 = Estratto(Es,R2,P8)
                                             If E2 = C Or E2 = D Then
                                                ColoreTesto 2
                                             Else
                                                ColoreTesto 0
                                             End If
                                             Scrivi Format2(E2) & " ",1,0
                                             ColoreTesto 0
                                          Next
                                          Scrivi "  Somma Evidenziati = " & Format2(Somma2),1
                                          '
                                          Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                          Scrivi "  " & SiglaRuota(R3) & " ",1,0
                                          For P9 = 1 To 5
                                             E3 = Estratto(Es,R3,P9)
                                             If E3 = E Or E3 = F Then
                                                ColoreTesto 2
                                             Else
                                                ColoreTesto 0
                                             End If
                                             Scrivi Format2(E3) & " ",1,0
                                             ColoreTesto 0
                                          Next
                                          Scrivi "  Somma Evidenziati = " & Format2(Somma3),1
                                          Scrivi
                                          If Vis = 1 Then DisegnaCerchioCiclometrico Num,1,1,,,1,1
                                          Ruo(1) = R1 : Ruo(2) = R2 : Ruo(3) = R3
                                          G = 1
                                          ImpostaGiocata G,Amba,Ruo,Posta,Clp1
                                          For X = 1 To UBound(Num)
                                             If Amba(1) <> Num(X)Then
                                                Ambo(1) = Amba(1): Ambo(2) = Num(X)
                                                If Ambo(2) > 0 Then
                                                   G = G + 1
                                                   ImpostaGiocata G,Ambo,Ruo,Poste,Clp2
                                                End If
                                             End If
                                          Next
                                          Gioca Es,1
                                       End If
                                    End If
                                 Next
                              Next
                           Next
                        End If
                     Next
                  Next
               Next
            Next
           
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi TempoTrascorso
End Sub
 
Ultima modifica:
Due Ruote Esagono Regolare Con Controllo a Ritroso
Ricerca di due numeri mancanti per completare esagono regolare

Codice:
Option Explicit
Sub Main
   Dim Es,Fin,R1,R2,A,B,C,D,E1,E2,Clp1
   Dim P1,P2,P3,P4,P5,P6,Caso,Casi,Ini
   Dim H12,H23,H34,X1,X2,Ok,Cerch,Salvo50
   Dim Sf1,Sf2,Ind,Num(6),Poste(3)
   Dim SAC,SBD,SAD,SBC,Nu1(1),Nu2(1),Amba(2)
   Dim Amba1(1),Amba2(1),H(4),L(6),Posta(1),Ruota(2)
   Posta(1) = 1
   Poste(2) = 1
   Poste(3) = 1
   Fin = EstrazioneFin
   Clp1 = InputBox(" Per quanti colpi vuoi giocare l'ambata? ",Salvo50,9)
   Ind = InputBox(" Per quanti colpi vuoi andare indietro nella ricerca dei numeri usciti? ",Salvo50,4)
   Cerch = InputBox(" Vuoi visualizzare il cerchi ciclometrico, se si metti 1 altrimenti un qualsiasi altro numero) ",Salvo50,1)
   Ini = InputBox("Da quale estrazione vuoi iniziare?",,10660)
   Call ScegliRange(Ini,Fin,Ini,EstrazioneFin)
   Scrivi Space(8) & "Due Ruote Esagono Regolare Con Controllo a Ritroso - Script Salvo50" & Space(8),1,,4,,3,,1
   Scrivi Space(10) & "Ricerca di due numeri mancanti per completare esagono regolare " & Space(10),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
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        If((P1 = P3 And P2 = P4) Xor(P2 = P1 + 1 And P4 = P3 + 1))Xor((P1 = P3 And P2 = P4) And(P2 = P1 + 1 And P4 = P3 + 1)) Then
                           C = Estratto(Es,R2,P3) : If C > 0 Then
                           D = Estratto(Es,R2,P4)
                           If(Distanza(A,B) = 45) And((Distanza(C,D) = 30) Or(Distanza(C,D) = 60)) _
                              Xor(Distanza(C,D) = 45) And((Distanza(A,B) = 30) Or(Distanza(A,B) = 60)) Then
                              SAC = Fuori90(A + C) : SBD = Fuori90(B + D) : SAD = Fuori90(A + D) : SBC = Fuori90(B + C)
                              H(1) = SAC : H(2) = SBD : H(3) = SAD : H(4) = SBC
                              Call OrdinaMatrice(H,1)
                              H12 = Distanza(H(1),H(2)) : H23 = Distanza(H(2),H(3)) : H34 = Distanza(H(3),H(4))
                              Ok = 0
                              If H12 = 15 And H23 = 15 And H34 = 45 Then X1 = H(3) + 15 : X2 = X1 + 15 : Ok = 1
                              If H12 = 45 And H23 = 15 And H34 = 15 Then X1 = H(1) + 15 : X2 = X1 + 15 : Ok = 1
                              If H12 = 15 And H23 = 45 And H34 = 15 Then X1 = H(2) + 15 : X2 = X1 + 15 : Ok = 1
                              If H12 = 15 And H23 = 30 And H34 = 30 Then X1 = H(2) + 15 : X2 = H(3) + 15 : Ok = 1
                              If H12 = 30 And H23 = 30 And H34 = 15 Then X1 = H(1) + 15 : X2 = H(2) + 15 : Ok = 1
                              If H12 = 30 And H23 = 15 And H34 = 30 Then X1 = H(1) + 15 : X2 = H(3) + 15 : Ok = 1
                              If H12 = 15 And H23 = 15 And H34 = 15 Then X1 = H(4) + 15 : X2 = X1 + 15 : X1 = Fuori90(X1) : X2 = Fuori90(X2) : Ok = 1
                              If H12 = 15 And H23 = 15 And H34 = 30 Then X1 = H(3) + 15 : X2 = H(4) + 15 : X2 = Fuori90(X2) : Ok = 1
                              If H12 = 30 And H23 = 15 And H34 = 15 Then X1 = H(1) + 15 : X2 = H(4) + 15 : X2 = Fuori90(X2) : Ok = 1
                              If H12 = 15 And H23 = 30 And H34 = 15 Then X1 = H(2) + 15 : X2 = H(4) + 15 : X2 = Fuori90(X2) : Ok = 1
                              If Ok = 1 Then
                                 L(1) = H(1) : L(2) = H(2) : L(3) = H(3) : L(4) = H(4) : L(5) = X1 : L(6) = X2
                                 Call OrdinaMatrice(L,1)
                                 Ruota(1) = R1
                                 Ruota(2) = R2
                                 Nu1(1) = X1 : Nu2(1) = X2
                                 Sf1 = SerieFreq(Es - Ind,Es,Nu1,Ruota,1)
                                 Sf2 = SerieFreq(Es - Ind,Es,Nu2,Ruota,1)
                                 If Sf1 = 0 Or Sf2 = 0 Then
                                    Caso = Caso + 1
                                    Casi = Casi + 1
                                    ColoreTesto 1
                                    Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
                                    ColoreTesto 2
                                    Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
                                    ColoreTesto 0
                                    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
                                    'Scrivi
                                    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
                                    Scrivi
                                    Scrivi "   Ambi  " & Space(9) & " Somme Vert." & Space(10) & " Somme Diag.",1
                                    Scrivi "  " & Format2(A) & Space(1) & Format2(B) & Space(16) & Format2(SAC) & Space(19) & Format2(SAD),1
                                    Scrivi "  " & Format2(C) & Space(1) & Format2(D) & Space(16) & Format2(SBD) & Space(19) & Format2(SBC),1
                                    Scrivi
                                    Scrivi " I 4 numeri ricavati dalle somme vert. e diag. " & Format2(H(1)) & " " & Format2(H(2)),1,0
                                    Scrivi " " & Format2(H(3)) & " " & Format2(H(4)),1
                                    Scrivi " I 2 numeri mancanti per formare l'esagono regolare  ",1,0
                                    ColoreTesto 2
                                    Scrivi Format2(X1) & " " & Format2(X2),1 : ColoreTesto 0
                                    Scrivi " I 6 numeri distanza 15 che formano l'esagono  " & Format2(L(1)) & " " & Format2(L(2)),1,0
                                    Scrivi " " & Format2(L(3)) & " " & Format2(L(4)) & " " & Format2(L(5)) & " " & Format2(L(6)),1
                                    Scrivi
                                    If Cerch = 1 Then
                                       DisegnaCerchioCiclometrico L,1,,,,1
                                    End If
                                    Amba(1) = X1 : Amba(2) = X2
                                    If Sf1 = 0 And Sf2 > 0 Then ImpostaGiocata 1,Amba1,Ruota,Posta,Clp1
                                    Amba2(1) = X2
                                    If Sf2 = 0 And Sf1 > 0 Then ImpostaGiocata 1,Amba2,Ruota,Posta,Clp1,3
                                    Num(1) = SAC : Num(2) = SBD : Num(3) = SAD : Num(4) = SBC : Num(5) = X1 : Num(6) = X2
                                    ImpostaGiocata 2,Num,Ruota,Poste,Clp1
                                    Gioca Es
                                 End If
                              End If
                           End If
                        End If
                     End If
                  Next
               Next
            Next
         Next
      Next
   Next
Next
ScriviResoconto
End Sub
 
Ambo stessa Posizione 2 Ruote e con Distanza Diagonale o Verticale od Orizontale

Codice:
Option Explicit
Sub Main()
   Dim Quante,Dist,Rit,Ini,Fin,Es,Ex,R1,R2
   Dim P1,P2,A,B,C,D,Sf,Cont,Manca1,Manca2,Clp
   Dim N1(2),N2(2),Ruote(2),Posta(2),Tot(6),Ru(1),Num(2)
   Posta(1) = 1
   Posta(2) = 1
   Quante = CInt(InputBox("QUANTE ESTRAZIONI VUOI CONTROLLARE ?","•damper•",8))
   If Quante = False Then Exit Sub
   Dist = 30 'CInt(InputBox("Quale Distanza",,30))
   Rit = InputBox("Quale Ritardo ruota2 ricercare",,10)
   Clp = CInt(InputBox("QUANTI COLPI VUOI GIOCARE?",,10))
   Scrivi "Ambo stessa Posizione 2 Ruote e con Distanza Diagonale o Verticale od Orizontale = " & Dist,1,,,,3,,1
   Scrivi
   Ini = EstrazioneFin - Quante
   Fin = EstrazioneFin
   For Es = Ini To Fin
      Messaggio "[" & Es & "]ª"
      AvanzamentoElab Ini,Fin,Es
      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 Ex = Es - Rit To Es - 1
                  For R2 = 1 To 12
                     If R2 = 11 Then R2 = 12
                     C = Estratto(Ex,R2,P1)
                     D = Estratto(Ex,R2,P2)
                     If(Distanza(A,D) = Dist And Distanza(B,C) = Dist) Xor(Distanza(A,C) = Dist And Distanza(B,D) = Dist)_
                        Xor(Distanza(A,B) = Dist And Distanza(C,D) = Dist) Then
                        N1(1) = A
                        N1(2) = B
                        N2(1) = C
                        N2(2) = D
                        Ru(1) = R2
                        Sf = SerieRitardo(Ini,Es,N2,Ru,2)
                        If Sf < Rit Then
                           Cont = Cont + 1 : Scrivi
                           ColoreTesto 2 : Scrivi String(41,32) & " Caso n° " & Cont,1 : ColoreTesto 0 : Scrivi
                           Scrivi GetInfoEstrazione(Es) & vbTab & SiglaRuota(R1) & vbTab & StringaEstratti(Es,R1),1,0
                           Scrivi Space(10) & StringaNumeri(N1,,1) & vbTab & "(" & P1 & "-" & P2 & ")",1
                           Scrivi Space(74) & "         Distanza    ",1,0
                           ColoreTesto 2 : Scrivi Dist,1 : ColoreTesto 0
                           Scrivi GetInfoEstrazione(Ex) & vbTab & SiglaRuota(R2) & vbTab & StringaEstratti(Ex,R2),1,0
                           Scrivi Space(10) & StringaNumeri(N2,,1) & vbTab & "(" & P1 & "-" & P2 & ")" & vbTab & Sf,1
                           If Distanza(A,B) = Dist And Distanza(C,D) = Dist Then
                              If A > B And Abs(A - B) = 60 Then Manca1 = Fuori90(A - Dist)
                              If A > B And Abs(A - B) = 30 Then Manca1 = Fuori90(A + Dist)
                              If B > A And Abs(B - A) = 60 Then Manca1 = Fuori90(B - Dist)
                              If B > A And Abs(B - A) = 30 Then Manca1 = Fuori90(B + Dist)
                              If C > D And Abs(C - D) = 60 Then Manca2 = Fuori90(C - Dist)
                              If C > D And Abs(C - D) = 30 Then Manca2 = Fuori90(C + Dist)
                              If D > C And Abs(D - C) = 60 Then Manca2 = Fuori90(D - Dist)
                              If D > C And Abs(D - C) = 30 Then Manca2 = Fuori90(D + Dist)
                           End If
                           If Distanza(A,C) = Dist And Distanza(B,D) Then
                              If A > C And Abs(A - C) = 60 Then Manca1 = Fuori90(A - Dist)
                              If A > C And Abs(A - C) = 30 Then Manca1 = Fuori90(A + Dist)
                              If C > A And Abs(C - A) = 60 Then Manca1 = Fuori90(C - Dist)
                              If C > A And Abs(C - A) = 30 Then Manca1 = Fuori90(C + Dist)
                              If B > D And Abs(B - D) = 60 Then Manca2 = Fuori90(B - Dist)
                              If B > D And Abs(B - D) = 30 Then Manca2 = Fuori90(B + Dist)
                              If D > B And Abs(D - B) = 60 Then Manca2 = Fuori90(D - Dist)
                              If D > B And Abs(D - B) = 30 Then Manca2 = Fuori90(D + Dist)
                           End If
                           If Distanza(A,D) = Dist And Distanza(B,C) = Dist Then
                              If A > D And Abs(A - D) = 60 Then Manca1 = Fuori90(A - Dist)
                              If A > D And Abs(A - D) = 30 Then Manca1 = Fuori90(A + Dist)
                              If D > A And Abs(D - A) = 60 Then Manca1 = Fuori90(D - Dist)
                              If D > A And Abs(D - A) = 30 Then Manca1 = Fuori90(D + Dist)
                              If C > B And Abs(C - B) = 60 Then Manca2 = Fuori90(C - Dist)
                              If C > B And Abs(C - B) = 30 Then Manca2 = Fuori90(C + Dist)
                              If B > C And Abs(B - C) = 60 Then Manca2 = Fuori90(B - Dist)
                              If B > C And Abs(B - C) = 30 Then Manca2 = Fuori90(B + Dist)
                           End If
                           Scrivi
                           Scrivi Space(20) & " Mancano i numeri ",1,0
                           ColoreTesto 2 : Scrivi Format2(Manca1) & " e " & Format2(Manca2),1,0 : ColoreTesto 0
                           Scrivi " per chiudere le due terzine",1
                           Scrivi
                           Tot(1) = A
                           Tot(2) = B
                           Tot(3) = C
                           Tot(4) = D
                           Tot(5) = Manca1
                           Tot(6) = Manca2
                           DisegnaCerchioCiclometrico Tot,1,,,,1
                           Ruote(1) = R1
                           Ruote(2) = R2
                           Num(1) = Manca1 : Num(2) = Manca2
                           ImpostaGiocata 1,Num,Ruote,Posta,Clp
                           Gioca Es
                           Scrivi String(90,"=")
                        End If
                     End If
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub
 
Ultima modifica:
I Quattro Vertici

'https://forum.lottoced.com/threads/i-quattro-vertici-listato.2199767/

Codice:
Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,E,X,Clp,Es,Es2,Cer
   Dim R1,R2,P1,P2,P3,P4,P5,Salvo50,Ok,Sp
   Dim DM13,DM34,DM45,DM51,Caso,Casi,Quar
   Dim Num1,Num2,Num3,Num4,Qua(4)
   Dim Amba(1),Ambo1(2),Ambo2(2),Ambo3(2),Ruo(2)
   Dim Nu1(2),Nu2(2),Nu3(2),Nu4(2),L(6),M(5),N(4)
   Dim Posta(1),Poste(2),Posts(4),Ruote(4)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9627))'9627 ESEMPIO NELL'ARTICOLO
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   Quar = CInt(InputBox(" Vuoi Giocare Anche la Quartina? SI = 1, NO un qualsiasi altro numero ",Salvo50,0))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(14) & "I Quattro Vertici di Angelo Gargiulo - Script Salvo50" & Space(14),1,,4,,3,,1
   Posta(1) = 1
   Poste(2) = 1
   Posts(2) = 1
   Posts(3) = 1
   'Posts(4) = 1
   Sp = " "
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 12
         If R1 = 11 Then R1 = 12
         For P1 = 1 To 3
            For P2 = P1 + 1 To 4
               For P3 = P2 + 1 To 5
                  A = Estratto(Es,R1,P1)
                  B = Estratto(Es,R1,P2)
                  C = Estratto(Es,R1,P3)
                  For R2 = 1 To 12
                     If R2 <> R1 Then
                        If R2 = 11 Then R2 = 12
                        For P4 = 1 To 4
                           For P5 = P4 + 1 To 5
                              D = Estratto(Es,R2,P4)
                              E = Estratto(Es,R2,P5)
                              If A > 0 And D > 0 Then
                                 If(A = D And B <> E And C <> E) Or(A = E And B <> D And C <> D)_
                                    Or(B = D And A <> E And C <> E) Or(B = E And A <> D And C <> D)_
                                    Or(C = D And A <> E And B <> E) Or(C = E And A <> D And B <> D) Then
                                    M(1) = A : M(2) = B : M(3) = C : M(4) = D : M(5) = E
                                    Call OrdinaMatrice(M,1)
                                    DM13 = Distanza(M(1),M(3)) : DM34 = Distanza(M(3),M(4))
                                    DM45 = Distanza(M(4),M(5)) : DM51 = Distanza(M(5),M(1))
                                    If DM13 = 09 And DM34 = 27 And DM45 = 18 And DM51 = 36 _
                                       Or DM34 = 09 And DM45 = 27 And DM51 = 18 And DM13 = 36 _
                                       Or DM45 = 09 And DM51 = 27 And DM13 = 18 And DM34 = 36 _
                                       Or DM51 = 09 And DM13 = 27 And DM34 = 18 And DM45 = 36 Then
                                       '---------------------------------
                                       If DM13 = 09 And DM34 = 27 And DM45 = 18 And DM51 = 36 Then
                                          L(1) = M(1) : L(2) = M(3) : L(3) = M(4) : L(4) = M(5)
                                       End If
                                       If DM34 = 09 And DM45 = 27 And DM51 = 18 And DM13 = 36 Then
                                          L(1) = M(3) : L(2) = M(4) : L(3) = M(5) : L(4) = M(1)
                                       End If
                                       If DM45 = 09 And DM51 = 27 And DM13 = 18 And DM34 = 36 Then
                                          L(1) = M(4) : L(2) = M(5) : L(3) = M(1) : L(4) = M(3)
                                       End If
                                       If DM51 = 09 And DM13 = 27 And DM34 = 18 And DM45 = 36 Then
                                          L(1) = M(5) : L(2) = M(1) : L(3) = M(3) : L(4) = M(4)
                                       End If
                                       L(5) = Fuori90(L(4) + 18)
                                       L(6) = Diametrale(L(5))
                                       N(1) = Fuori90(L(4) + 9)
                                       N(2) = Fuori90(N(1) + 18)
                                       N(3) = Fuori90(L(2) + 9)
                                       N(4) = Fuori90(L(3) + 9)
                                       Nu1(1) = L(4) : Nu1(2) = L(5)
                                       Nu2(1) = L(5) : Nu2(2) = L(1)
                                       Nu3(1) = L(2) : Nu3(2) = L(6)
                                       Nu4(1) = L(3) : Nu4(2) = L(4)
                                       Ruo(1) = R1 : Ruo(2) = R2
                                       Ok = 0
                                       For Es2 = Es - 1 To Es - 30 Step - 1
                                          If SerieFreqTurbo(Es2,Es2,Nu1,Ruo,2) > 0 Then
                                             Num1 = N(1) : Num2 = N(2) : Num3 = N(3) : Num4 = N(4)
                                             Ok = 1 : Exit For
                                          End If
                                          '
                                          If SerieFreqTurbo(Es2,Es2,Nu2,Ruo,2) > 0 Then
                                             Num1 = N(2) : Num2 = N(1) : Num3 = N(3) : Num4 = N(4)
                                             Ok = 1 : Exit For
                                          End If
                                          If SerieFreqTurbo(Es2,Es2,Nu3,Ruo,2) > 0 Then
                                             Num1 = N(3) : Num2 = N(1) : Num3 = N(2) : Num4 = N(4)
                                             Ok = 1 : Exit For
                                          End If
                                          If SerieFreqTurbo(Es2,Es2,Nu4,Ruo,2) > 0 Then
                                             Num1 = N(4) : Num2 = N(1) : Num3 = N(2) : Num4 = N(3)
                                             Ok = 1 : Exit For
                                          End If
                                       Next
                                       If Ok = 1 Then
                                          Amba(1) = Num1
                                          Ambo1(1) = Num1: Ambo1(2) = Num2
                                          Ambo2(1) = Num1: Ambo2(2) = Num3
                                          Ambo3(1) = Num1: Ambo3(2) = Num4
                                          Qua(1) = Num1 : Qua(2) = Num2 : Qua(3) = Num3 : Qua(4) = Num4
                                          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
                                          ReDim MatrCasella(5,1)
                                          MatrCasella(1,0) = R1
                                          MatrCasella(1,1) = P1
                                          MatrCasella(2,0) = R1
                                          MatrCasella(2,1) = P2
                                          MatrCasella(3,0) = R1
                                          MatrCasella(3,1) = P3
                                          MatrCasella(4,0) = R2
                                          MatrCasella(4,1) = P4
                                          MatrCasella(5,0) = R2
                                          MatrCasella(5,1) = P5
                                          Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
                                          Scrivi
                                          
                                          If Cer = 1 Then
                                             DisegnaCerchioCiclometrico M,1,1,,,1,1
                                             DisegnaCerchioCiclometrico L,1,1,,,1,1
                                             DisegnaCerchioCiclometrico N,1,1,,,1,1
                                          End If
                                          Scrivi
                                          Scrivi Space(24) & Format2(Num1) & " Ambata",1,,,2
                                          Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1
                                          Scrivi Space(24) & Format2(Num2) & Sp & Format2(Num3) & Sp & Format2(Num4),1

                                          Scrivi
                                          Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
                                          ImpostaGiocata 1,Amba,Ruo,Posta,5
                                          ImpostaGiocata 2,Ambo1,Ruote,Poste,Clp
                                          ImpostaGiocata 3,Ambo2,Ruote,Poste,Clp
                                          ImpostaGiocata 4,Ambo3,Ruote,Poste,Clp
                                          If Quar = 1 Then ImpostaGiocata 5,Qua,Ruote,Posts,Clp
                                          Gioca Es,1
                                       End If
                                    End If
                                 End If
                              End If
                           Next
                        Next
                     End If
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi " Tempo Trascorso" & TempoTrascorso
End Sub

SENZA NUMERO UGUALE
Codice:
Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,Clp,Es,Es2,Cer,Sp
   Dim R1,R2,P1,P2,P3,P4,P5,Salvo50,Ok
   Dim DM12,DM23,DM34,DM41,Caso,Casi,Quar
   Dim Num1,Num2,Num3,Num4,Qua(4)
   Dim Amba(1),Ambo1(2),Ambo2(2),Ambo3(2),Ruo(2)
   Dim Nu1(2),Nu2(2),Nu3(2),Nu4(2),L(6),M(4),N(4)
   Dim Posta(1),Poste(2),Posts(4),Ruote(4)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9850))'9627 ESEMPIO NELL'ARTICOLO
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   Quar = CInt(InputBox(" Vuoi Giocare Anche la Quartina? SI = 1, NO un qualsiasi altro numero ",Salvo50,0))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(14) & "I Quattro Vertici di Angelo Gargiulo - Script Salvo50" & Space(14),1,,4,,3,,1
   Scrivi Space(19) & "Senza Numero Uguale Nelle Ruote di Calcolo" & Space(20),1,,4,,3,,1
   Sp = " "
   Posta(1) = 1
   Poste(2) = 1
   Posts(2) = 1
   Posts(3) = 1
   'Posts(4) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 12
         If R1 = 11 Then R1 = 12
         For P1 = 1 To 3
            For P2 = P1 + 1 To 4
               For P3 = P2 + 1 To 5
                  A = Estratto(Es,R1,P1)
                  B = Estratto(Es,R1,P2)
                  C = Estratto(Es,R1,P3)
                  For R2 = 1 To 12
                     If R2 <> R1 Then
                        If R2 = 11 Then R2 = 12
                        For P4 = 1 To 5
                           D = Estratto(Es,R2,P4)
                           If A > 0 And D > 0 Then
                              If A <> D And B <> D And C <> D Then
                                 M(1) = A : M(2) = B : M(3) = C : M(4) = D
                                 Call OrdinaMatrice(M,1)
                                 DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
                                 DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
                                 If DM12 = 09 And DM23 = 27 And DM34 = 18 And DM41 = 36 _
                                    Or DM23 = 09 And DM34 = 27 And DM41 = 18 And DM12 = 36 _
                                    Or DM34 = 09 And DM41 = 27 And DM12 = 18 And DM23 = 36 _
                                    Or DM41 = 09 And DM12 = 27 And DM23 = 18 And DM34 = 36 Then
                                    '---------------------------------
                                    If DM12 = 09 And DM23 = 27 And DM34 = 18 And DM41 = 36 Then
                                       L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
                                    End If
                                    If DM23 = 09 And DM34 = 27 And DM41 = 18 And DM12 = 36 Then
                                       L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
                                    End If
                                    If DM34 = 09 And DM41 = 27 And DM12 = 18 And DM23 = 36 Then
                                       L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
                                    End If
                                    If DM41 = 09 And DM12 = 27 And DM23 = 18 And DM34 = 36 Then
                                       L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
                                    End If
                                    L(5) = Fuori90(L(4) + 18)
                                    L(6) = Diametrale(L(5))
                                    N(1) = Fuori90(L(4) + 9)
                                    N(2) = Fuori90(N(1) + 18)
                                    N(3) = Fuori90(L(2) + 9)
                                    N(4) = Fuori90(L(3) + 9)
                                    Nu1(1) = L(4) : Nu1(2) = L(5)
                                    Nu2(1) = L(5) : Nu2(2) = L(1)
                                    Nu3(1) = L(2) : Nu3(2) = L(6)
                                    Nu4(1) = L(3) : Nu4(2) = L(4)
                                    Ruo(1) = R1 : Ruo(2) = R2
                                    Ok = 0
                                    For Es2 = Es - 1 To Es - 30 Step - 1
                                       If SerieFreqTurbo(Es2,Es2,Nu1,Ruo,2) > 0 Then
                                          Num1 = N(1) : Num2 = N(2) : Num3 = N(3) : Num4 = N(4)
                                          Ok = 1 : Exit For
                                       End If
                                       If SerieFreqTurbo(Es2,Es2,Nu2,Ruo,2) > 0 Then
                                          Num1 = N(2) : Num2 = N(1) : Num3 = N(3) : Num4 = N(4)
                                          Ok = 1 : Exit For
                                       End If
                                       If SerieFreqTurbo(Es2,Es2,Nu3,Ruo,2) > 0 Then
                                          Num1 = N(3) : Num2 = N(1) : Num3 = N(2) : Num4 = N(4)
                                          Ok = 1 : Exit For
                                       End If
                                       If SerieFreqTurbo(Es2,Es2,Nu4,Ruo,2) > 0 Then
                                          Num1 = N(4) : Num2 = N(1) : Num3 = N(2) : Num4 = N(3)
                                          Ok = 1 : Exit For
                                       End If
                                    Next
                                    If Ok = 1 Then
                                       Amba(1) = Num1
                                       Ambo1(1) = Num1: Ambo1(2) = Num2
                                       Ambo2(1) = Num1: Ambo2(2) = Num3
                                       Ambo3(1) = Num1: Ambo3(2) = Num4
                                       Qua(1) = Num1 : Qua(2) = Num2 : Qua(3) = Num3 : Qua(4) = Num4
                                       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
                                       ReDim MatrCasella(4,1)
                                       MatrCasella(1,0) = R1
                                       MatrCasella(1,1) = P1
                                       MatrCasella(2,0) = R1
                                       MatrCasella(2,1) = P2
                                       MatrCasella(3,0) = R1
                                       MatrCasella(3,1) = P3
                                       MatrCasella(4,0) = R2
                                       MatrCasella(4,1) = P4
                                       Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
                                       Scrivi
                                       If Cer = 1 Then
                                          DisegnaCerchioCiclometrico M,1,1,,,1,1
                                          DisegnaCerchioCiclometrico L,1,1,,,1,1
                                          DisegnaCerchioCiclometrico N,1,1,,,1,1
                                       End If
                                       Scrivi
                                       Scrivi Space(24) & Format2(Num1) & " Ambata",1,,,2
                                       Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1
                                       Scrivi Space(23) & Format2(Num2) & Sp & Format2(Num3) & Sp & Format2(Num4),1
                                       Scrivi
                                       Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
                                       ImpostaGiocata 1,Amba,Ruo,Posta,5
                                       ImpostaGiocata 2,Ambo1,Ruote,Poste,Clp
                                       ImpostaGiocata 3,Ambo2,Ruote,Poste,Clp
                                       ImpostaGiocata 4,Ambo3,Ruote,Poste,Clp
                                       If Quar = 1 Then ImpostaGiocata 5,Qua,Ruote,Posts,Clp
                                       Gioca Es,1
                                    End If
                                 End If
                              End If
                           End If
                        Next
                     End If
                  Next
               Next
            Next
         Next
         If ScriptInterrotto Then Exit Sub
      Next
      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
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        C = Estratto(Es,R2,P3)
                        D = Estratto(Es,R2,P4)
                        If A > 0 And D > 0 Then
                           If A <> C And A <> D And B <> C And B <> D Then
                              M(1) = A : M(2) = B : M(3) = C : M(4) = D
                              Call OrdinaMatrice(M,1)
                              DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
                              DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
                              If DM12 = 09 And DM23 = 27 And DM34 = 18 And DM41 = 36 _
                                 Or DM23 = 09 And DM34 = 27 And DM41 = 18 And DM12 = 36 _
                                 Or DM34 = 09 And DM41 = 27 And DM12 = 18 And DM23 = 36 _
                                 Or DM41 = 09 And DM12 = 27 And DM23 = 18 And DM34 = 36 Then
                                 '---------------------------------
                                 If DM12 = 09 And DM23 = 27 And DM34 = 18 And DM41 = 36 Then
                                    L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
                                 End If
                                 If DM23 = 09 And DM34 = 27 And DM41 = 18 And DM12 = 36 Then
                                    L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
                                 End If
                                 If DM34 = 09 And DM41 = 27 And DM12 = 18 And DM23 = 36 Then
                                    L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
                                 End If
                                 If DM41 = 09 And DM12 = 27 And DM23 = 18 And DM34 = 36 Then
                                    L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
                                 End If
                                 L(5) = Fuori90(L(4) + 18)
                                 L(6) = Diametrale(L(5))
                                 N(1) = Fuori90(L(4) + 9)
                                 N(2) = Fuori90(N(1) + 18)
                                 N(3) = Fuori90(L(2) + 9)
                                 N(4) = Fuori90(L(3) + 9)
                                 Nu1(1) = L(4) : Nu1(2) = L(5)
                                 Nu2(1) = L(5) : Nu2(2) = L(1)
                                 Nu3(1) = L(2) : Nu3(2) = L(6)
                                 Nu4(1) = L(3) : Nu4(2) = L(4)
                                 Ruo(1) = R1 : Ruo(2) = R2
                                 Ok = 0
                                 For Es2 = Es - 1 To Es - 30 Step - 1
                                    If SerieFreqTurbo(Es2,Es2,Nu1,Ruo,2) > 0 Then
                                       Num1 = N(1) : Num2 = N(2) : Num3 = N(3) : Num4 = N(4)
                                       Ok = 1 : Exit For
                                    End If
                                    '
                                    If SerieFreqTurbo(Es2,Es2,Nu2,Ruo,2) > 0 Then
                                       Num1 = N(2) : Num2 = N(1) : Num3 = N(3) : Num4 = N(4)
                                       Ok = 1 : Exit For
                                    End If
                                    If SerieFreqTurbo(Es2,Es2,Nu3,Ruo,2) > 0 Then
                                       Num1 = N(3) : Num2 = N(1) : Num3 = N(2) : Num4 = N(4)
                                       Ok = 1 : Exit For
                                    End If
                                    If SerieFreqTurbo(Es2,Es2,Nu4,Ruo,2) > 0 Then
                                       Num1 = N(4) : Num2 = N(1) : Num3 = N(2) : Num4 = N(3)
                                       Ok = 1 : Exit For
                                    End If
                                 Next
                                 If Ok = 1 Then
                                    Amba(1) = Num1
                                    Ambo1(1) = Num1: Ambo1(2) = Num2
                                    Ambo2(1) = Num1: Ambo2(2) = Num3
                                    Ambo3(1) = Num1: Ambo3(2) = Num4
                                    Qua(1) = Num1 : Qua(2) = Num2 : Qua(3) = Num3 : Qua(4) = Num4
                                    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
                                    ReDim MatrCasella(4,1)
                                    MatrCasella(1,0) = R1
                                    MatrCasella(1,1) = P1
                                    MatrCasella(2,0) = R1
                                    MatrCasella(2,1) = P2
                                    MatrCasella(3,0) = R2
                                    MatrCasella(3,1) = P3
                                    MatrCasella(4,0) = R2
                                    MatrCasella(4,1) = P4
                                    Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
                                    Scrivi
                                    If Cer = 1 Then
                                       DisegnaCerchioCiclometrico M,1,1,,,1,1
                                       DisegnaCerchioCiclometrico L,1,1,,,1,1
                                       DisegnaCerchioCiclometrico N,1,1,,,1,1
                                    End If
                                    Scrivi
                                    Scrivi Space(24) & Format2(Num1) & " Ambata",1,,,2
                                    Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1
                                    Scrivi Space(23) & Format2(Num2) & Sp & Format2(Num3) & Sp & Format2(Num4),1
                                    Scrivi
                                    Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
                                    ImpostaGiocata 1,Amba,Ruo,Posta,5
                                    ImpostaGiocata 2,Ambo1,Ruote,Poste,Clp
                                    ImpostaGiocata 3,Ambo2,Ruote,Poste,Clp
                                    ImpostaGiocata 4,Ambo3,Ruote,Poste,Clp
                                    If Quar = 1 Then ImpostaGiocata 5,Qua,Ruote,Posts,Clp
                                    Gioca Es,1
                                 End If
                              End If
                           End If
                        End If
                     Next
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi " Tempo Trascorso" & TempoTrascorso
End Sub
 
Quale dei due
'https://forum.lottoced.com/threads/listato-per-metodo-ciclometrico.2199684/

Codice:
Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,X,Clp,Es,Cer
   Dim R1,R2,P1,P2,P3,P4,Salvo50
   Dim DM12,DM23,DM34,DM41,Caso,Casi
   Dim Amba(1),Ambo1(2),Ambo2(2),Terna(3),Ruo(2)
   Dim Po1(1),Po2(2),Po3(3),L(6),M(4),Ruote(4)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9800))
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(14) & "QUALE DEI DUE (2) di ANGELO GARGIULO - SCRIPT SALVO50" & Space(14),1,,4,,3,,1
   Po1(1) = 1
   Po2(2) = 1
   Po3(2) = 1
   'Po3(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
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        C = Estratto(Es,R2,P3)
                        D = Estratto(Es,R2,P4)
                        If A > 0 And D > 0 Then
                           If D <> A And D <> B And C <> A And C <> B Then
                              M(1) = A : M(2) = B : M(3) = C : M(4) = D
                              Call OrdinaMatrice(M,1)
                              DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
                              DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
                              If DM12 = 27 And DM23 = 9 And DM34 = 9 And DM41 = 45 _
                                 Or DM23 = 27 And DM34 = 9 And DM41 = 9 And DM12 = 45 _
                                 Or DM34 = 27 And DM41 = 9 And DM12 = 9 And DM23 = 45 _
                                 Or DM41 = 27 And DM12 = 9 And DM23 = 9 And DM34 = 45 Then
                                 '---------------------------------
                                 If DM12 = 27 And DM23 = 9 And DM34 = 9 And DM41 = 45 Then
                                    L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
                                    L(5) = Diametrale(M(2)) : X = M(2)
                                 End If
                                 If DM23 = 27 And DM34 = 9 And DM41 = 9 And DM12 = 45 Then
                                    L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
                                    L(5) = Diametrale(M(3)) : X = M(3)
                                 End If
                                 If DM34 = 27 And DM41 = 9 And DM12 = 9 And DM23 = 45 Then
                                    L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
                                    L(5) = Diametrale(M(4)) : X = M(4)
                                 End If
                                 If DM41 = 27 And DM12 = 9 And DM23 = 9 And DM34 = 45 Then
                                    L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
                                    L(5) = Diametrale(M(1)) : X = M(1)
                                 End If
                                 L(6) = Fuori90(L(5) + 9)
                                 Amba(1) = L(5)
                                 Ambo1(1) = L(5): Ambo1(2) = L(6)
                                 Ambo2(1) = L(5): Ambo2(2) = Diametrale(L(6))
                                 Terna(1) = L(5): Terna(2) = L(6): Terna(3) = Ambo2(2)
                                 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
                                 ReDim MatrCasella(4,1)
                                 MatrCasella(1,0) = R1
                                 MatrCasella(1,1) = P1
                                 MatrCasella(2,0) = R1
                                 MatrCasella(2,1) = P2
                                 MatrCasella(3,0) = R2
                                 MatrCasella(3,1) = P3
                                 MatrCasella(4,0) = R2
                                 MatrCasella(4,1) = P4
                                 Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
                                 Scrivi
                                 Scrivi Space(24) & " Ambata",1,,,2
                                 Scrivi Space(17) & " Diametrale di " & Format2(X) & " = ",1,0
                                 Scrivi Format2(L(5)),1,,,2
                                 Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1
                                 Scrivi Space(20) & Format2(L(6)) & " Abbinamento 1 ",1
                                 Scrivi Space(20) & Format2(Ambo2(2)) & " Abbinamento 2 ",1
                                 Scrivi Space(24) & " Terno ",1,,,1
                                 Scrivi Space(24) & StringaNumeri(Terna," ",True),1
                                 Scrivi
                                 If Cer = 1 Then
                                    DisegnaCerchioCiclometrico M,1,1,,,1,1
                                    DisegnaCerchioCiclometrico L,1,1,,,1,1
                                 End If
                                 Scrivi
                                 Ruo(1) = R1 : Ruo(2) = R2
                                 Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
                                 ImpostaGiocata 1,Amba,Ruo,Po1,5
                                 ImpostaGiocata 2,Ambo1,Ruote,Po2,Clp
                                 ImpostaGiocata 3,Ambo2,Ruote,Po2,Clp
                                 ImpostaGiocata 4,Terna,Ruote,Po3,Clp
                                 Gioca Es,1
                              End If
                           End If
                        End If
                     Next
                  Next
               Next
            Next
         Next
         If ScriptInterrotto Then Exit Sub
      Next
      For R1 = 1 To 12
         If R1 = 11 Then R1 = 12
         For P1 = 1 To 3
            For P2 = P1 + 1 To 4
               For P3 = P2 + 1 To 5
                  A = Estratto(Es,R1,P1)
                  B = Estratto(Es,R1,P2)
                  C = Estratto(Es,R1,P3)
                  For R2 = R1 + 1 To 12
                     If R2 <> R1 Then
                        If R2 = 11 Then R2 = 12
                        For P4 = 1 To 5
                           D = Estratto(Es,R2,P4)
                           If A > 0 And D > 0 Then
                              If D <> A And D <> B And D <> C Then
                                 M(1) = A : M(2) = B : M(3) = C : M(4) = D
                                 Call OrdinaMatrice(M,1)
                                 DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
                                 DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
                                 If DM12 = 27 And DM23 = 9 And DM34 = 9 And DM41 = 45 _
                                    Or DM23 = 27 And DM34 = 9 And DM41 = 9 And DM12 = 45 _
                                    Or DM34 = 27 And DM41 = 9 And DM12 = 9 And DM23 = 45 _
                                    Or DM41 = 27 And DM12 = 9 And DM23 = 9 And DM34 = 45 Then
                                    '---------------------------------
                                    If DM12 = 27 And DM23 = 9 And DM34 = 9 And DM41 = 45 Then
                                       L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
                                       L(5) = Diametrale(M(2)) : X = M(2)
                                    End If
                                    If DM23 = 27 And DM34 = 9 And DM41 = 9 And DM12 = 45 Then
                                       L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
                                       L(5) = Diametrale(M(3)) : X = M(3)
                                    End If
                                    If DM34 = 27 And DM41 = 9 And DM12 = 9 And DM23 = 45 Then
                                       L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
                                       L(5) = Diametrale(M(4)) : X = M(4)
                                    End If
                                    If DM41 = 27 And DM12 = 9 And DM23 = 9 And DM34 = 45 Then
                                       L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
                                       L(5) = Diametrale(M(1)) : X = M(1)
                                    End If
                                    L(6) = Fuori90(L(5) + 9)
                                    Amba(1) = L(5)
                                    Ambo1(1) = L(5): Ambo1(2) = L(6)
                                    Ambo2(1) = L(5): Ambo2(2) = Diametrale(L(6))
                                    Terna(1) = L(5): Terna(2) = L(6): Terna(3) = Ambo2(2)
                                    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
                                    ReDim MatrCasella(4,1)
                                    MatrCasella(1,0) = R1
                                    MatrCasella(1,1) = P1
                                    MatrCasella(2,0) = R1
                                    MatrCasella(2,1) = P2
                                    MatrCasella(3,0) = R1
                                    MatrCasella(3,1) = P3
                                    MatrCasella(4,0) = R2
                                    MatrCasella(4,1) = P4
                                    Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
                                    Scrivi
                                    Scrivi Space(24) & " Ambata",1,,,2
                                    Scrivi Space(17) & " Diametrale di " & Format2(X) & " = ",1,0
                                    Scrivi Format2(L(5)),1,,,2
                                    Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1
                                    Scrivi Space(20) & Format2(L(6)) & " Abbinamento 1 ",1
                                    Scrivi Space(20) & Format2(Ambo2(2)) & " Abbinamento 2 ",1
                                    Scrivi Space(24) & " Terno ",1,,,1
                                    Scrivi Space(24) & StringaNumeri(Terna," ",True),1
                                    Scrivi
                                    If Cer = 1 Then
                                       DisegnaCerchioCiclometrico M,1,1,,,1,1
                                       DisegnaCerchioCiclometrico L,1,1,,,1,1
                                    End If
                                    Scrivi
                                    Ruo(1) = R1 : Ruo(2) = R2
                                    Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
                                    ImpostaGiocata 1,Amba,Ruo,Po1,5
                                    ImpostaGiocata 2,Ambo1,Ruote,Po2,Clp
                                    ImpostaGiocata 3,Ambo2,Ruote,Po2,Clp
                                    ImpostaGiocata 4,Terna,Ruote,Po3,Clp
                                    Gioca Es,1
                                 End If
                              End If
                           End If
                        Next
                     End If
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi " Tempo Trascorso" & TempoTrascorso
End Sub
 
Sequenza 18-18-9-9

'https://forum.lottoced.com/threads/listato-per-la-sequenza-18-18-9-9.2199553/

Codice:
Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,Clp,Es,Cer
   Dim R1,R2,P1,P2,P3,P4,Salvo50
   Dim DM12,DM23,DM34,DM41,Caso,Casi
   Dim Ambo(2),Posta(2),L(6),M(4),Ruote(4)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9890))'9008 ESEMPIO NELL'ARTICOLO
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(14) & "LA SEQUENZA 18-18-9-9 di ANGELO GARGIULO - SCRIPT SALVO50" & Space(14),1,,4,,3,,1
   Posta(2) = 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
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        C = Estratto(Es,R2,P3)
                        D = Estratto(Es,R2,P4)
                        If A > 0 And D > 0 Then
                           If D <> A And D <> B And D <> C Then
                              M(1) = A : M(2) = B : M(3) = C : M(4) = D
                              Call OrdinaMatrice(M,1)
                              'M1--M2
                              '|   |
                              'M4--M3
                              DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
                              DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
                              If DM12 = 18 And DM23 = 18 And DM34 = 9 And DM41 = 45 _
                                 Or DM23 = 18 And DM34 = 18 And DM41 = 9 And DM12 = 45 _
                                 Or DM34 = 18 And DM41 = 18 And DM12 = 9 And DM23 = 45 _
                                 Or DM41 = 18 And DM12 = 18 And DM23 = 9 And DM34 = 45 Then
                                 '---------------------------------
                                 If DM12 = 18 And DM23 = 18 And DM34 = 9 And DM41 = 45 Then
                                    L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
                                    L(5) = Fuori90(M(4) + 9)
                                 End If
                                 If DM23 = 18 And DM34 = 18 And DM41 = 9 And DM12 = 45 Then
                                    L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
                                    L(5) = Fuori90(M(1) + 9)
                                 End If
                                 If DM34 = 18 And DM41 = 18 And DM12 = 9 And DM23 = 45 Then
                                    L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
                                    L(5) = Fuori90(M(2) + 9)
                                 End If
                                 If DM41 = 18 And DM12 = 18 And DM23 = 9 And DM34 = 45 Then
                                    L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
                                    L(5) = Fuori90(M(3) + 9)
                                 End If
                                 L(6) = Fuori90(L(5) + 27)
                                 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
                                 ReDim MatrCasella(4,1)
                                 MatrCasella(1,0) = R1
                                 MatrCasella(1,1) = P1
                                 MatrCasella(2,0) = R1
                                 MatrCasella(2,1) = P2
                                 MatrCasella(3,0) = R2
                                 MatrCasella(3,1) = P3
                                 MatrCasella(4,0) = R2
                                 MatrCasella(4,1) = P4
                                 Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
                                 Scrivi
                                 Scrivi " Le Distanze" & Space(14),1,0
                                 Scrivi "18  18  09  09  27",1,,,2
                                 Scrivi " Estratti e Pronostico  " & StringaNumeri(L,"  ",True),1
                                 Scrivi
                                 Scrivi " Pronostico Ambo        " & Format2(L(5)) & " " & Format2(L(6)),1,,,1
                                 Scrivi
                                 If Cer = 1 Then
                                    DisegnaCerchioCiclometrico M,1,1,,,1,1
                                    DisegnaCerchioCiclometrico L,1,1,,,1,1
                                 End If
                                 Scrivi
                                 Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
                                 Ambo(1) = L(5) : Ambo(2) = L(6)
                                 ImpostaGiocata 1,Ambo,Ruote,Posta,Clp
                                 Gioca Es,1
                              End If
                           End If
                        End If
                     Next
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
    For R1 = 1 To 12
         If R1 = 11 Then R1 = 12
         For P1 = 1 To 3
            For P2 = P1 + 1 To 4
               For P3 = P2 + 1 To 5
                  A = Estratto(Es,R1,P1)
                  B = Estratto(Es,R1,P2)
                  C = Estratto(Es,R1,P3)
                  For R2 = 1 To 12
                     If R2 = 11 Then R2 = 12
                     If R1 <> R2 Then
                        For P4 = 1 To 5
                           D = Estratto(Es,R2,P4)
                           If A > 0 And D > 0 Then
                              If D <> A And D <> B And D <> C Then
                                 M(1) = A : M(2) = B : M(3) = C : M(4) = D
                                 Call OrdinaMatrice(M,1)
                                 'M1--M2
                                 '|   |
                                 'M4--M3
                                 DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
                                 DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
                                 If DM12 = 18 And DM23 = 18 And DM34 = 9 And DM41 = 45 _
                                    Or DM23 = 18 And DM34 = 18 And DM41 = 9 And DM12 = 45 _
                                    Or DM34 = 18 And DM41 = 18 And DM12 = 9 And DM23 = 45 _
                                    Or DM41 = 18 And DM12 = 18 And DM23 = 9 And DM34 = 45 Then
                                    '---------------------------------
                                    If DM12 = 18 And DM23 = 18 And DM34 = 9 And DM41 = 45 Then
                                    L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
                                    L(5) = Fuori90(M(4) + 9)
                                 End If
                                 If DM23 = 18 And DM34 = 18 And DM41 = 9 And DM12 = 45 Then
                                    L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
                                    L(5) = Fuori90(M(1) + 9)
                                 End If
                                 If DM34 = 18 And DM41 = 18 And DM12 = 9 And DM23 = 45 Then
                                    L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
                                    L(5) = Fuori90(M(2) + 9)
                                 End If
                                 If DM41 = 18 And DM12 = 18 And DM23 = 9 And DM34 = 45 Then
                                    L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
                                    L(5) = Fuori90(M(3) + 9)
                                 End If
                                 L(6) = Fuori90(L(5) + 27)

                                    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
                                    ReDim MatrCasella(4,1)
                                    MatrCasella(1,0) = R1
                                    MatrCasella(1,1) = P1
                                    MatrCasella(2,0) = R1
                                    MatrCasella(2,1) = P2
                                    MatrCasella(3,0) = R1
                                    MatrCasella(3,1) = P3
                                    MatrCasella(4,0) = R2
                                    MatrCasella(4,1) = P4
                                    Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
                                    Scrivi
                                Scrivi " Le Distanze" & Space(14),1,0
                                 Scrivi "18  18  09  09  27",1,,,2
                                 Scrivi " Estratti e Pronostico  " & StringaNumeri(L,"  ",True),1
                                 Scrivi
                                 Scrivi " Pronostico Ambo        " & Format2(L(5)) & " " & Format2(L(6)),1,,,1

                                 Scrivi

                                    If Cer = 1 Then
                                       DisegnaCerchioCiclometrico M,1,1,,,1,1
                                       DisegnaCerchioCiclometrico L,1,1,,,1,1
                                    End If
                                    Scrivi
                                    Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_ : Ruote(4) = TT_
                                    Ambo(1) = L(5) : Ambo(2) = L(6)
                                    ImpostaGiocata 1,Ambo,Ruote,Posta,Clp
                                    Gioca Es,1
                                 End If
                              End If
                           End If
                        Next
                     End If
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi " Tempo Trascorso" & TempoTrascorso
End Sub
 
Pentagono Armonico Figurale

Codice:
Option Explicit
Sub Main
   Dim FIn,Es,Ini,A,B,C,D,Clp,Es1,Cer,Salvo50
   Dim R1,R2,P1,P2,P3,P4,P5,P6,E1,E2,Caso,Casi
   Dim SAB,SCD,SAC,SBD,DAB,DCD,FA,FB,FC,FD,XS1,S1,DS1
   Dim BM1(2),Amba(1),Ambo1(2),Ambo2(2),Ambo3(2),L(4)
   Dim Ambo4(2),Penta(5),Ruo(2),Po1(1),Po2(2),Po5(5)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10660))
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,5))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   Call ScegliRange(EstrazioneIni,FIn,Ini,EstrazioneFin)
   Scrivi Space(12) & " PENTAGONO ARMONICO FIGURALE CON DISTANZA UGUALE DI NOEL  - SCRIPT SALVO50",1,,4,,3,,1
   Po1(1) = 1
   Po2(2) = 1
   Po5(2) = 1
   Po5(3) = 1
   'Po5(4) = 1
   'Po5(5) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 9
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               For Es1 = Es To Es + 5
                  For R2 = R1 + 1 To 10
                     For P3 = 1 To 4
                        For P4 = P3 + 1 To 5
                           C = Estratto(Es1,R2,P3)
                           D = Estratto(Es1,R2,P4)
                           'A---B
                           '|   |
                           'C---D
                           SAB = Fuori90(A + B) : SCD = Fuori90(C + D) : DAB = Distanza(A,B) : DCD = Distanza(C,D)
                           SAC = Fuori90(A + C) : SBD = Fuori90(B + D)
                           If(SAB <> SCD)And(DAB = DCD) Then
                              FA = Figura(A) : FB = Figura(B) : FC = Figura(C) : FD = Figura(D)
                              If FA = FB And FA = FC And FA = FD Then
                                 If A <> C And A <> D And B <> C And B <> D Then
                                    'If pari(DAB) And pari(DCD) And pari(SAB) And pari(SCD) Then
                                       If SAC > SBD Then
                                          XS1 = A + C
                                       Else
                                          XS1 = B + D
                                       End If
                                       '
                                       S1 = XS1 / 2
                                       DS1 = Diametrale(S1)
                                       BM1(1) = S1 : BM1(2) = DS1
                                       Call OrdinaMatrice(BM1,- 1)
                                       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 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
                                       Scrivi(" Estrazione n." & Format2(Es1) & " del " & DataEstrazione(Es1)),1,0
                                       Scrivi "  " & SiglaRuota(R2) & " ",1,0
                                       For P6 = 1 To 5
                                          E2 = Estratto(Es1,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
                                       If Cer = 1 Then
                                          L(1) = A : L(2) = B : L(3) = C : L(4) = D
                                          DisegnaCerchioCiclometrico L,1,,,,1
                                       End If
                                       Scrivi
                                       Scrivi Space(7) & "Estratti " & Space(25) & "Somme " & Space(10) & " distanze",1
                                       Scrivi Space(7) & "Figura " & FA & Space(23) & "Orizzontali        Orizzontali ",1
                                       Scrivi Space(8) & Format2(A) & " " & Format2(B),1,0
                                       Scrivi Space(29) & Format2(SAB) & Space(17) & Format2(DAB),1
                                       Scrivi Space(8) & Format2(C) & " " & Format2(D),1,0
                                       Scrivi Space(29) & Format2(SCD) & Space(17) & Format2(DCD),1
                                       Scrivi
                                       Ruo(1) = R1
                                       Ruo(2) = R2
                                       Amba(1) = BM1(1)
                                       ImpostaGiocata 1,Amba,Ruo,Po1,Clp,1
                                       Ambo1(1) = BM1(1) : Ambo1(2) = A
                                       ImpostaGiocata 2,Ambo1,Ruo,Po2,Clp,2
                                       Ambo2(1) = BM1(1) : Ambo2(2) = B
                                       ImpostaGiocata 3,Ambo2,Ruo,Po2,Clp,2
                                       Ambo3(1) = BM1(1) : Ambo3(2) = C
                                       ImpostaGiocata 4,Ambo3,Ruo,Po2,Clp,2
                                       Ambo4(1) = BM1(1): Ambo4(2) = D
                                       ImpostaGiocata 5,Ambo4,Ruo,Po2,Clp,2
                                       Penta(1) = FA : Penta(2) = A : Penta(3) = B : Penta(4) = C : Penta(5) = D
                                       ImpostaGiocata 6,Penta,Ruo,Po5,Clp
                                       Gioca Es1
                                    End If
                                 'End If
                              End If
                           End If
                        Next
                     Next
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub
 
Ambi con somme uguali - metodo di Noel

Postato in un altro sito

Codice:
Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,Clp,Es,Es2,Cer,E1,E2,G
   Dim R1,R2,P1,P2,P3,P4,P5,P6,Unouno50,X,Ind
   Dim DM12,DM23,DM34,DM41,SAB,SCD,Caso,Casi
   Dim Amba(1),Ambo(2),Penta(5),L(6),M(4)
   Dim Pos1(1),Pos2(2),Pos3(5),Ruote(2)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Unouno50,10660))'Estrazione 7359 esempio nelle spiegazioni
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Unouno50,13))
   Ind = CInt(InputBox(" Per quante Estrazioni a Ritroso Vuoi fare la Ricerca del Secondo Ambo?",Unouno50,7))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Unouno50,1))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(10) & "Per Dragonzf - Metodo di Noel - Script Unouno50 (Alias Salvo50)" & Space(10),1,,4,,3,,1
   Scrivi Space(26) & " Con Somma Uguale Dei due Ambi " & Space(26),1,,4,,3,,1
   Pos1(1) = 1
   Pos2(2) = 1
   Pos3(2) = 1
   Pos3(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)
               SAB = Fuori90(A + B)
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        For Es2 = Es To Es - Ind Step - 1
                           C = Estratto(Es2,R2,P3)
                           D = Estratto(Es2,R2,P4)
                           SCD = Fuori90(C + D)
                           If A > 0 And C > 0 And(SAB = SCD) Then
                              If A <> C And A <> D And B <> C And B <> D Then
                                 M(1) = A : M(2) = B : M(3) = C : M(4) = D
                                 Call OrdinaMatrice(M,1)
                                 DM12 = Distanza(M(1),M(2)) : DM23 = Distanza(M(2),M(3))
                                 DM34 = Distanza(M(3),M(4)) : DM41 = Distanza(M(4),M(1))
                                 If DM12 = 9 And DM23 = 18 And DM34 = 9 And DM41 = 36 _
                                    Or DM23 = 9 And DM34 = 18 And DM41 = 9 And DM12 = 36 _
                                    Or DM34 = 9 And DM41 = 18 And DM12 = 9 And DM23 = 36 _
                                    Or DM41 = 9 And DM12 = 18 And DM23 = 9 And DM34 = 36 Then
                                    '---------------------------------
                                    If DM12 = 9 And DM23 = 18 And DM34 = 9 And DM41 = 36 Then
                                       L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
                                       L(5) = Fuori90(M(2) + 9)
                                    End If
                                    If DM23 = 9 And DM34 = 18 And DM41 = 9 And DM12 = 36 Then
                                       L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
                                       L(5) = Fuori90(M(3) + 9)
                                    End If
                                    If DM34 = 9 And DM41 = 18 And DM12 = 9 And DM23 = 36 Then
                                       L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
                                       L(5) = Fuori90(M(4) + 9)
                                    End If
                                    If DM41 = 9 And DM12 = 18 And DM23 = 9 And DM34 = 36 Then
                                       L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
                                       L(5) = Fuori90(M(1) + 9)
                                    End If
                                    L(6) = Diametrale(L(5))
                                    Amba(1) = L(5)
                                    Penta(1) = L(6) : Penta(2) = A : Penta(3) = B : Penta(4) = C : Penta(5) = D
                                    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
                                    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 " Evidenziati con Somma " & Format2(SAB),1,,,2
                                    Scrivi(" Estrazione n." & Format2(Es2) & " del " & DataEstrazione(Es2)),1,0
                                    Scrivi "  " & SiglaRuota(R2) & " ",1,0
                                    For P6 = 1 To 5
                                       E2 = Estratto(Es2,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 " Evidenziati con Somma " & Format2(SCD),1,,,2
                                    Scrivi
                                    Scrivi Space(17) & " Punto Medio = ",1,0
                                    Scrivi Format2(L(5)) & " Ambata",1,,,2
                                    Scrivi Space(18) & " Abbinamenti Per Ambo ",1,,,1
                                    Scrivi Space(23) & StringaNumeri(M," ",True),1
                                    Scrivi Space(23) & " Cinquina ",1,,,1
                                    Scrivi Space(21) & StringaNumeri(Penta," ",True),1
                                    Scrivi
                                    If Cer = 1 Then
                                       DisegnaCerchioCiclometrico M,1,1,,,1,1
                                       DisegnaCerchioCiclometrico L,1,1,,,1,1
                                    End If
                                    Scrivi
                                    Ruote(1) = R1 : Ruote(2) = R2
                                    G = 1
                                    ImpostaGiocata G,Amba,Ruote,Pos1,Clp
                                    For X = 1 To UBound(M)
                                       Ambo(1) = Amba(1): Ambo(2) = M(X)
                                       If Ambo(2) > 0 Then
                                          G = G + 1
                                          ImpostaGiocata G,Ambo,Ruote,Pos2,Clp
                                       End If
                                    Next
                                    G = G + 1
                                    ImpostaGiocata G,Penta,Ruote,Pos3,Clp
                                    Gioca Es,1
                                 End If
                              End If
                           End If
                        Next
                     Next
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi " Tempo Trascorso" & TempoTrascorso
End Sub
 
Ambi Massimi Formativi - Fabarri

Codice:
Option Explicit
Sub Main
   Dim FIn,Ini,A1,A2,A3,Clp,Es,Cer,Salvo50,Sp
   Dim R1,R2,R3,P1,P2,P3,P4,E1,Caso,Casi
   Dim DA12,DA13,DA23,MSA12,MSA23,X1,X2,Dist1,Dist2
   Dim Ambo1(2),Ambo2(2),Ambo3(2)
   Dim Ambo4(2),Ambo5(2),Ambo6(2)
   Dim Ruote(2),Ruo(1),Posta(2),L(8),M(4)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10600))' 5428 PRIMO ESEMPIO NELLE SPIEGAZIONI
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,15))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
 '  Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(17) & "Ambi Massimi Formativi - Fabarri - Script Salvo50" & Space(17),1,,4,,3,,1
   Posta(2) = 1
   Sp = " "
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 12
         If R1 = 11 Then R1 = 12
         For P1 = 1 To 3
            P2 = P1 + 1
            P3 = P2 + 1
            A1 = Estratto(Es,R1,P1)
            If A1 > 0 Then
               A2 = Estratto(Es,R1,P2)
               A3 = Estratto(Es,R1,P3)
               DA12 = Differenza(A1,A2) : DA23 = Differenza(A2,A3) : DA13 = Differenza(A1,A3)
               If DA13 >= 24 And DA13 <= 72 Then
                  If(pari(A1) And pari(A2) And pari(A3)) Or(dispari(A1) And dispari(A2) And dispari(A3)) Then
                     If A1 <> 90 And A2 <> 90 And A3 <> 90 And A1 <> 17 And A2 <> 17 And A3 <> 17 Then
                        If(A2 > A1 And A3 > A2) Then
                           If(DA12 >= 6) Then
                              X1 =((90 + A1) - DA23)
                              Ruo(1) = R1
                              X2 = Fuori90(A3 + DA12)
                              MSA12 =((A1 + A2)\ 2)
                              Ambo1(1) = X1 : Ambo1(2) = MSA12
                              If SerieFreq(Es,Es,Ambo1,Ruo,2) = 0 Then
                                 Dist1 = Distanza(MSA12,X1)
                                 Ambo2(1) = X1 : Ambo2(2) = Dist1
                                 If SerieFreq(Es,Es,Ambo2,Ruo,2) = 0 Then
                                    MSA23 =((A2 + A3)\ 2)
                                    Ambo3(1) = X2 : Ambo3(2) = MSA23
                                    If SerieFreq(Es,Es,Ambo3,Ruo,2) = 0 Then
                                       Dist2 = Distanza(MSA23,X2)
                                       Ambo4(1) = X2 : Ambo4(2) = Dist2
                                       If SerieFreq(Es,Es,Ambo4,Ruo,2) = 0 Then
                                          Ambo5(1) = X1 : Ambo5(2) = X2
                                          If SerieFreq(Es,Es,Ambo5,Ruo,2) = 0 Then
                                             Ambo6(1) = MSA12 : Ambo6(2) = MSA23
                                             If SerieFreq(Es,Es,Ambo6,Ruo,2) = 0 Then
                                                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 P4 = 1 To 5
                                                   E1 = Estratto(Es,R1,P4)
                                                   If E1 = A1 Or E1 = A2 Or E1 = A3 Then
                                                      ColoreTesto 2
                                                   Else
                                                      ColoreTesto 0
                                                   End If
                                                   Scrivi Format2(E1) & " ",1,0
                                                   ColoreTesto 0
                                                Next
                                                Scrivi
                                                Scrivi
                                                Scrivi Space(25) & "TERNA ASCENDENTE",1
                                                If Cer = 1 Then
                                                   M(1) = A1 : M(2) = A2 : M(3) = A3
                                                   DisegnaCerchioCiclometrico M,1,,,,1
                                                End If
                                                If Cer = 1 Then
                                                   L(1) = X1 : L(2) = A1 : L(3) = A2 : L(4) = A3 : L(5) = X2
                                                   DisegnaCerchioCiclometrico L,1,,,,1
                                                End If
                                                Scrivi
                                                Scrivi
                                                Ruote(1) = R1 : Ruote(2) = TU_
                                                ImpostaGiocata 1,Ambo1,Ruote,Posta,Clp,2
                                                ImpostaGiocata 2,Ambo2,Ruote,Posta,Clp,2
                                                ImpostaGiocata 3,Ambo3,Ruote,Posta,Clp,2
                                                ImpostaGiocata 4,Ambo4,Ruote,Posta,Clp,2
                                                ImpostaGiocata 5,Ambo5,Ruote,Posta,Clp,2
                                                ImpostaGiocata 6,Ambo6,Ruote,Posta,Clp,2
                                                Gioca Es,1,,1
                                             End If
                                          End If
                                       End If
                                    End If
                                 End If
                              End If
                           End If
                        End If
                     End If
                  End If
               End If
            End If
         Next
         If ScriptInterrotto Then Exit Sub
      Next
      For R1 = 1 To 12
         If R1 = 11 Then R1 = 12
         For P1 = 1 To 3
            P2 = P1 + 1
            P3 = P2 + 1
            A1 = Estratto(Es,R1,P1)
            If A1 > 0 Then
               A2 = Estratto(Es,R1,P2)
               A3 = Estratto(Es,R1,P3)
               DA12 = Differenza(A1,A2) : DA23 = Differenza(A2,A3) : DA13 = Differenza(A1,A3)
               If DA13 >= 24 And DA13 <= 72 Then
                  If(pari(A1) And pari(A2) And pari(A3))Or(dispari(A1) And dispari(A2) And dispari(A3)) Then
                     If A1 <> 90 And A2 <> 90 And A3 <> 90 And A1 <> 17 And A2 <> 17 And A3 <> 17 Then
                        If(A2 > A3 And A1 > A2) Then
                           If(DA23 >= 6) Then
                              X1 = Fuori90((90 + A3) - DA12)
                              Ruo(1) = R1
                              X2 = Fuori90(A1 + DA23)
                              MSA12 =((A1 + A2)/ 2)
                              Ambo1(1) = X1 : Ambo1(2) = MSA12
                              If SerieFreq(Es,Es,Ambo1,Ruo,2) = 0 Then
                                 Dist1 = Distanza(MSA12,X1)
                                 Ambo2(1) = X1 : Ambo2(2) = Dist1
                                 If SerieFreq(Es,Es,Ambo2,Ruo,2) = 0 Then
                                    MSA23 =((A2 + A3)/ 2)
                                    Ambo3(1) = X2 : Ambo3(2) = MSA23
                                    If SerieFreq(Es,Es,Ambo3,Ruo,2) = 0 Then
                                       Dist2 = Distanza(MSA23,X2)
                                       Ambo4(1) = X2 : Ambo4(2) = Dist2
                                       If SerieFreq(Es,Es,Ambo4,Ruo,2) = 0 Then
                                          Ambo5(1) = X1 : Ambo5(2) = X2
                                          If SerieFreq(Es,Es,Ambo5,Ruo,2) = 0 Then
                                             Ambo6(1) = MSA12 : Ambo6(2) = MSA23
                                             If SerieFreq(Es,Es,Ambo6,Ruo,2) = 0 Then
                                                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 P4 = 1 To 5
                                                   E1 = Estratto(Es,R1,P4)
                                                   If E1 = A1 Or E1 = A2 Or E1 = A3 Then
                                                      ColoreTesto 2
                                                   Else
                                                      ColoreTesto 0
                                                   End If
                                                   Scrivi Format2(E1) & " ",1,0
                                                   ColoreTesto 0
                                                Next
                                                Scrivi
                                                Scrivi
                                                Scrivi Space(25) & "TERNA DISCENDENTE",1
                                                If Cer = 1 Then
                                                   M(1) = A1 : M(2) = A2 : M(3) = A3
                                                   DisegnaCerchioCiclometrico M,1,,,,1
                                                End If
                                                If Cer = 1 Then
                                                   L(1) = X1 : L(2) = A1 : L(3) = A2 : L(4) = A3 : L(5) = X2
                                                   DisegnaCerchioCiclometrico L,1,,,,1
                                                End If
                                                Scrivi
                                                Scrivi
                                                Ruote(1) = R1 : Ruote(2) = TU_
                                                ImpostaGiocata 1,Ambo1,Ruote,Posta,Clp,2
                                                ImpostaGiocata 2,Ambo2,Ruote,Posta,Clp,2
                                                ImpostaGiocata 3,Ambo3,Ruote,Posta,Clp,2
                                                ImpostaGiocata 4,Ambo4,Ruote,Posta,Clp,2
                                                ImpostaGiocata 5,Ambo5,Ruote,Posta,Clp,2
                                                ImpostaGiocata 6,Ambo6,Ruote,Posta,Clp,2
                                                Gioca Es,1,,1
                                             End If
                                          End If
                                       End If
                                    End If
                                 End If
                              End If
                           End If
                        End If
                     End If
                  End If
               End If
            End If
         Next
         If ScriptInterrotto Then Exit Sub
      Next
   Next
   ScriviResoconto
   Scrivi "Tempo Trascorso" & TempoTrascorso,1
End Sub
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 01 luglio 2025
    Bari
    71
    66
    48
    42
    76
    Cagliari
    84
    70
    23
    69
    43
    Firenze
    50
    21
    30
    11
    69
    Genova
    89
    41
    50
    80
    67
    Milano
    41
    59
    67
    03
    60
    Napoli
    87
    63
    51
    42
    07
    Palermo
    56
    87
    76
    27
    09
    Roma
    41
    26
    50
    22
    77
    Torino
    36
    83
    80
    65
    05
    Venezia
    45
    77
    76
    81
    71
    Nazionale
    72
    06
    03
    08
    07
    Estrazione Simbolotto
    Nazionale
    34
    27
    08
    12
    17

Ultimi Messaggi

Indietro
Alto