Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
x salvo e tutti
- Creatore Discussione DRAGON8698
- Data di inizio
-
- Tag
- listato gargiulo
salvo50
Advanced Member >PLATINUM PLUS<
Ciao a Tutti
Codice:
Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,Clp,Es,Cer
Dim R1,R2,P1,P2,P3,P4,Salvo50,Sp
Dim DM12,DM23,DM34,DM41,Caso,Casi,Ambetto
Dim Amba(1),Ambo1(2),Ambo2(2),Ruo(2),Ru(3)
Dim Po1(1),Po2(2),L(7),M(4)
Dim Ambetto1(2),Ambetto2(2),Ambetto3(2),Ambetto4(2)
Dim Ambetto5(2),Ambetto6(2),Ambetto7(2),Ambetto8(2)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10170))'10154 ESEMPIO NELL'ARTICOLO
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
Cer = CInt(InputBox(" Vuoi visualizzare i cerchi ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
Ambetto = CInt(InputBox(" Vuoi giocare gli ambetti? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(13) & "LA CHIUSURA ALTERNATIVA di ANGELO GARGIULO - SCRIPT SALVO50" & Space(13),1,,4,,3,,1
Po1(1) = 1
Po2(2) = 1
Sp = " "
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)
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 = 18 And DM41 = 36 _
Or DM23 = 18 And DM34 = 36 And DM41 = 18 And DM12 = 18 _
Or DM34 = 18 And DM41 = 18 And DM12 = 18 And DM23 = 36 _
Or DM41 = 18 And DM12 = 36 And DM23 = 18 And DM34 = 18 Then
'---------------------------------
If DM12 = 18 And DM23 = 18 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 = 18 And DM34 = 36 And DM41 = 18 And DM12 = 18 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
If DM34 = 18 And DM41 = 18 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 = 18 And DM12 = 36 And DM23 = 18 And DM34 = 18 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
L(5) = Fuori90(L(2) + 9)
L(6) = Fuori90(L(3) + 9)
L(7) = Fuori90(L(1) + 9)
Amba(1) = L(5)
Ambo1(1) = Amba(1) : Ambo1(2) = L(6)
Ambo2(1) = Amba(1) : Ambo2(2) = L(7)
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
End If
Scrivi
Scrivi Space(24) & Format2(Amba(1)) & " Ambata",1,,,2
Scrivi
Ruo(1) = R1 : Ruo(2) = R2
Ru(1) = R1 : Ru(2) = R2 : Ru(3) = TT_
ImpostaGiocata 1,Amba,Ruo,Po1,5,1
ImpostaGiocata 2,Ambo1,Ru,Po2,Clp
ImpostaGiocata 3,Ambo2,Ru,Po2,Clp
Gioca Es,1
If Ambetto = 1 Then
Ambetto1(1) = Ambo1(1) : Ambetto1(2) = Fuori90(Ambo1(2) + 1)
Ambetto2(1) = Ambo1(1) : Ambetto2(2) = Fuori90((90 + Ambo1(2)) - 1)
Ambetto3(1) = Ambo1(2) : Ambetto3(2) = Fuori90(Ambo1(1) + 1)
Ambetto4(1) = Ambo1(2) : Ambetto4(2) = Fuori90((90 + Ambo1(1)) - 1)
Ambetto5(1) = Ambo2(1) : Ambetto5(2) = Fuori90(Ambo2(2) + 1)
Ambetto6(1) = Ambo2(1) : Ambetto6(2) = Fuori90((90 + Ambo2(2)) - 1)
Ambetto7(1) = Ambo2(2) : Ambetto7(2) = Fuori90(Ambo2(1) + 1)
Ambetto8(1) = Ambo2(2) : Ambetto8(2) = Fuori90((90 + Ambo2(1)) - 1)
Scrivi Space(15) & "AMBETTI",1,,,2
ImpostaGiocata 4,Ambetto1,Ruo,Po2,Clp
ImpostaGiocata 5,Ambetto2,Ruo,Po2,Clp
ImpostaGiocata 6,Ambetto3,Ruo,Po2,Clp
ImpostaGiocata 7,Ambetto4,Ruo,Po2,Clp
ImpostaGiocata 8,Ambetto5,Ruo,Po2,Clp
ImpostaGiocata 9,Ambetto6,Ruo,Po2,Clp
ImpostaGiocata 10,Ambetto7,Ruo,Po2,Clp
ImpostaGiocata 11,Ambetto8,Ruo,Po2,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 Subsalvo50
Advanced Member >PLATINUM PLUS<
Grazie
Ciao
DRAGON8698
Member
GRAZIE
salvo50
Advanced Member >PLATINUM PLUS<
Ciao a Tutti
Claudio8, Cutoff, Dragon8698, Matematico, Rudivall, Toon
Grazie
Su suggerimento di Claudio8 ho messo VerificaAmbetto, però questa verifica non l'ho fatta sui 2 ambi, ma sulla terna (ambata più i 2 abbinamenti)
Qualche altro suggerimento è sempre gradito.
Claudio8, Cutoff, Dragon8698, Matematico, Rudivall, Toon
Grazie
Su suggerimento di Claudio8 ho messo VerificaAmbetto, però questa verifica non l'ho fatta sui 2 ambi, ma sulla terna (ambata più i 2 abbinamenti)
Qualche altro suggerimento è sempre gradito.
Codice:
Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,Clp,Es,Cer,RetNum,X,EsClp
Dim R1,R2,P1,P2,P3,P4,Salvo50,Sp,RetVinc
Dim DM12,DM23,DM34,DM41,Caso,Casi,Ambetto,Ambetti
Dim Amba(1),Ambo1(2),Ambo2(2),Ruo(2),Ru(3)
Dim Po1(1),Po2(2),L(7),M(4),Num(3)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10170))'10154 ESEMPIO NELL'ARTICOLO
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
Cer = CInt(InputBox(" Vuoi visualizzare i cerchi ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
Ambetti = CInt(InputBox(" Vuoi giocare gli ambetti? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(10) & "LA CHIUSURA ALTERNATIVA di ANGELO GARGIULO - SCRIPT SALVO50" & Space(10),1,,4,,3,,1
Po1(1) = 1
Po2(2) = 1
Sp = " "
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)
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 = 18 And DM41 = 36 _
Or DM23 = 18 And DM34 = 36 And DM41 = 18 And DM12 = 18 _
Or DM34 = 18 And DM41 = 18 And DM12 = 18 And DM23 = 36 _
Or DM41 = 18 And DM12 = 36 And DM23 = 18 And DM34 = 18 Then
'---------------------------------
If DM12 = 18 And DM23 = 18 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 = 18 And DM34 = 36 And DM41 = 18 And DM12 = 18 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
If DM34 = 18 And DM41 = 18 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 = 18 And DM12 = 36 And DM23 = 18 And DM34 = 18 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
L(5) = Fuori90(L(2) + 9)
L(6) = Fuori90(L(3) + 9)
L(7) = Fuori90(L(1) + 9)
Amba(1) = L(5)
Ambo1(1) = Amba(1) : Ambo1(2) = L(6)
Ambo2(1) = Amba(1) : Ambo2(2) = L(7)
Num(1) = L(5) : Num(2) = L(6) : Num(3) = L(7)
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
End If
Scrivi
Scrivi
Ruo(1) = R1 : Ruo(2) = R2
Ru(1) = R1 : Ru(2) = R2 : Ru(3) = TT_
ImpostaGiocata 1,Amba,Ruo,Po1,5,1
ImpostaGiocata 2,Ambo1,Ru,Po2,Clp
ImpostaGiocata 3,Ambo2,Ru,Po2,Clp
Gioca Es,1
If Ambetti = 1 Then
Scrivi Space(19) & "AMBETTI",1,,,2
EsClp = Es + Clp
If EsClp > FIn Then EsClp = FIn
For X = Es + 1 To EsClp
Ambetto = VerificaAmbetto(Num,R1,X,RetNum,RetVinc)
If Ambetto > 0 Then
Scrivi(" Estrazione n." & Format2(X) & " del " & DataEstrazione(X)),1,0
Scrivi " Ambetto su " & RetNum & Space(4) & " Vincita di " & RetVinc,1
Ambetto = 0
End If
Ambetto = VerificaAmbetto(Num,R2,X,RetNum,RetVinc)
If Ambetto > 0 Then
Scrivi(" Estrazione n." & Format2(X) & " del " & DataEstrazione(X)),1,0
Scrivi " Ambetto su " & RetNum & Space(4) & " Vincita di " & RetVinc,1
Ambetto = 0
End If
Next
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
Ultima modifica:
Ultima estrazione Lotto
-
Estrazione del lotto
venerdì 10 ottobre 2025Bari5079528845Cagliari3869862505Firenze8643663831Genova3313457709Milano0122593154Napoli6570145371Palermo5167827484Roma4618338808Torino7820230565Venezia5833405189Nazionale9074514140Estrazione Simbolotto
3637352131
