bubù
Advanced Member >PLATINUM PLUS<
Questo è quello nuovo completo che ho modificato, anche se non capisco perchè fa 2 previsioni una Completa e una ridotta ?
Option Explicit
Sub Main
Dim FIn,Es,Ini,Caso,Casi,Salvo50
Dim Visual,Met1,Met2,E1,E2,E3
Dim DM12,DM23,DM41,DM34,A,B,C,D,E
Dim Diam_E,Abb1,Abb2,Abb3,Abb4,Clp1,Clp2
Dim R1,R2,R3,P1,P2,P3,P4,P5,P6,P7,P8
Dim M(4),Z(5),N(5)
Dim Amba(1),Ambo1(2),Ambo2(2),Ambo3(2),Ambo4(2),Ambo5(2),Terno(3),Terno2(3)
Dim Ruo(2),Ruote(3),Posta(1),Poste(2),Posts(3)
Posta(1) = 1
Poste(2) = 1
Posts(2) = 1
Posts(3) = 1
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10831)
Clp1 = InputBox("Inserisci I colpi di gioco per l'ambata",Salvo50,9)
Clp2 = InputBox("Inserisci I colpi di gioco per le altre sorti",Salvo50,15)
Visual = InputBox("Se vuoi visualizzare i cerchiciclometrici metti 1, per non visualizzarli metti un qualsiasi altro numero ",Salvo50,1)
' Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi "8 Pigliatutto Autore Angelo Gargiulo - Mod 13 e Mod 22 - Vertice Avanti - Script Salvo50",1,,4,,3,,1
For Es = Ini To FIn - 1
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)
If isNumeroValidoLotto(A) Then
For R2 = 1 To 12
If R2 = 11 Then R2 = 12
If R2 <> R1 Then
For P4 = 1 To 5
D = Estratto(Es,R2,P4)
If isNumeroValidoLotto(D) 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 = 36 Or DM12 = 9 Then
If(DM12 = 36 And DM23 = 9 And DM34 = 36 And DM41 = 9)_
Or(DM41 = 36 And DM12 = 9 And DM23 = 36 And DM34 = 9) Then
If DM12 = 36 Then
Met1 = Fuori90(M(1) + 18)
Met2 = Fuori90(M(3) + 18)
End If
If DM23 = 36 Then
Met1 = Fuori90(M(2) + 18)
Met2 = Fuori90(M(4) + 18)
End If
For R3 = 1 To 12
If R3 = 11 Then R3 = 12
If R3 = R2 Or R3 = R1 Then
For P5 = 1 To 5
E = Estratto(Es + 1,R3,P5)
If E = Met1 Or E = Met2 Then
N(1) = A : N(2) = B : N(3) = C : N(4) = D : N(5) = E
Diam_E = Diametrale(E)
Abb1 = Fuori90(E + 9)
Abb2 = Fuori90((90 + E) - 9)
Abb3 = Diam_E + 9
Abb4 = Diam_E - 9
Z(1) = Diam_E : Z(2) = Abb1 : Z(3) = Abb2 : Z(4) = Abb3 : Z(5) = Abb4
Amba(1) = Diam_E
Ambo1(1) = Diam_E : Ambo1(2) = Abb1
Ambo2(1) = Diam_E : Ambo2(2) = Abb2
Ambo3(1) = Abb1 : Ambo3(2) = Abb2
Ambo4(1) = Diam_E : Ambo4(2) = Abb3
Ambo5(1) = Diam_E : Ambo5(2) = Abb4
Terno(1) = Diam_E : Terno(2) = Abb1 : Terno(3) = Abb2
Terno2(1) = Diam_E : Terno2(2) = Abb3 : Terno2(3) = Abb4
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 2
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P6 = 1 To 5
E1 = Estratto(Es,R1,P6)
If E1 = A Or E1 = B Or E1 = C Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P7 = 1 To 5
E2 = Estratto(Es,R2,P7)
If E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es + 1) & " del " & DataEstrazione(Es + 1)),1,0
Scrivi " " & SiglaRuota(R3) & " ",1,0
For P8 = 1 To 5
E3 = Estratto(Es + 1,R3,P8)
If E3 = E Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E3) & " ",1,0
ColoreTesto 0
Next
Scrivi
If Visual = 1 Then
DisegnaCerchioCiclometrico M,1,1,,,1,1
DisegnaCerchioCiclometrico N,1,1,,,1,1
DisegnaCerchioCiclometrico Z,1,1,,,1,1
End If
Ruo(1) = R1 : Ruo(2) = R2
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = TT_
ImpostaGiocata 1,Amba,Ruo,Posta,Clp1,,1
ImpostaGiocata 2,Ambo1,Ruote,Poste,Clp2,,1
ImpostaGiocata 3,Ambo2,Ruote,Poste,Clp2,,1
ImpostaGiocata 4,Ambo3,Ruote,Poste,Clp2,,1
ImpostaGiocata 5,Ambo4,Ruote,Poste,Clp2,,1
ImpostaGiocata 6,Ambo5,Ruote,Poste,Clp2,,1
ImpostaGiocata 7,Terno,Ruote,Posts,Clp2,,1
ImpostaGiocata 8,Terno2,Ruote,Posts,Clp2,,1
Gioca Es,1
End If
Next
End If
Next
End If
End If
End If
End If
If ScriptInterrotto Then Exit Sub
Next
End If
Next
End If '----
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)
If isNumeroValidoLotto(A) Then
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 isNumeroValidoLotto(C) Then
If C <> A And C <> B And D <> A And D <> 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 = 36 Or DM12 = 9 Then
If(DM12 = 36 And DM23 = 9 And DM34 = 36 And DM41 = 9)_
Or(DM41 = 36 And DM12 = 9 And DM23 = 36 And DM34 = 9) Then
If DM12 = 36 Then
Met1 = Fuori90(M(1) + 18)
Met2 = Fuori90(M(3) + 18)
End If
If DM23 = 36 Then
Met1 = Fuori90(M(2) + 18)
Met2 = Fuori90(M(4) + 18)
End If
For R3 = 1 To 12
If R3 = 11 Then R3 = 12
If R3 = R2 Or R3 = R1 Then
For P5 = 1 To 5
E = Estratto(Es + 1,R3,P5)
If E = Met1 Or E = Met2 Then
N(1) = A : N(2) = B : N(3) = C : N(4) = D : N(5) = E
Diam_E = Diametrale(E)
Abb1 = Fuori90(E + 9)
Abb2 = Fuori90((90 + E) - 9)
Z(1) = Diam_E : Z(2) = Abb1 : Z(3) = Abb2
Amba(1) = Diam_E
Ambo1(1) = Diam_E : Ambo1(2) = Abb1
Ambo2(1) = Diam_E : Ambo2(2) = Abb2
Ambo3(1) = Abb1 : Ambo3(2) = Abb2
Terno(1) = Diam_E : Terno(2) = Abb1 : Terno(3) = Abb2
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 2
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 1
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 P6 = 1 To 5
E1 = Estratto(Es,R1,P6)
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 P7 = 1 To 5
E2 = Estratto(Es,R2,P7)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es + 1) & " del " & DataEstrazione(Es + 1)),1,0
Scrivi " " & SiglaRuota(R3) & " ",1,0
For P8 = 1 To 5
E3 = Estratto(Es + 1,R3,P8)
If E3 = E Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E3) & " ",1,0
ColoreTesto 0
Next
Scrivi
If Visual = 1 Then
DisegnaCerchioCiclometrico M,1,1,,,1,1
DisegnaCerchioCiclometrico N,1,1,,,1,1
DisegnaCerchioCiclometrico Z,1,1,,,1,1
End If
Ruo(1) = R1 : Ruo(2) = R2
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = TT_
ImpostaGiocata 1,Amba,Ruo,Posta,Clp1,,1
ImpostaGiocata 2,Ambo1,Ruote,Poste,Clp2,,1
ImpostaGiocata 3,Ambo2,Ruote,Poste,Clp2,,1
ImpostaGiocata 4,Ambo3,Ruote,Poste,Clp2,,1
ImpostaGiocata 5,Terno,Ruote,Posts,Clp2,,1
Gioca Es,1
End If
Next
End If
Next
End If
End If
End If
End If
Next
If ScriptInterrotto Then Exit Sub
Next
Next
End If
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi TempoTrascorso
End Sub
Option Explicit
Sub Main
Dim FIn,Es,Ini,Caso,Casi,Salvo50
Dim Visual,Met1,Met2,E1,E2,E3
Dim DM12,DM23,DM41,DM34,A,B,C,D,E
Dim Diam_E,Abb1,Abb2,Abb3,Abb4,Clp1,Clp2
Dim R1,R2,R3,P1,P2,P3,P4,P5,P6,P7,P8
Dim M(4),Z(5),N(5)
Dim Amba(1),Ambo1(2),Ambo2(2),Ambo3(2),Ambo4(2),Ambo5(2),Terno(3),Terno2(3)
Dim Ruo(2),Ruote(3),Posta(1),Poste(2),Posts(3)
Posta(1) = 1
Poste(2) = 1
Posts(2) = 1
Posts(3) = 1
FIn = EstrazioneFin
Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10831)
Clp1 = InputBox("Inserisci I colpi di gioco per l'ambata",Salvo50,9)
Clp2 = InputBox("Inserisci I colpi di gioco per le altre sorti",Salvo50,15)
Visual = InputBox("Se vuoi visualizzare i cerchiciclometrici metti 1, per non visualizzarli metti un qualsiasi altro numero ",Salvo50,1)
' Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi "8 Pigliatutto Autore Angelo Gargiulo - Mod 13 e Mod 22 - Vertice Avanti - Script Salvo50",1,,4,,3,,1
For Es = Ini To FIn - 1
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)
If isNumeroValidoLotto(A) Then
For R2 = 1 To 12
If R2 = 11 Then R2 = 12
If R2 <> R1 Then
For P4 = 1 To 5
D = Estratto(Es,R2,P4)
If isNumeroValidoLotto(D) 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 = 36 Or DM12 = 9 Then
If(DM12 = 36 And DM23 = 9 And DM34 = 36 And DM41 = 9)_
Or(DM41 = 36 And DM12 = 9 And DM23 = 36 And DM34 = 9) Then
If DM12 = 36 Then
Met1 = Fuori90(M(1) + 18)
Met2 = Fuori90(M(3) + 18)
End If
If DM23 = 36 Then
Met1 = Fuori90(M(2) + 18)
Met2 = Fuori90(M(4) + 18)
End If
For R3 = 1 To 12
If R3 = 11 Then R3 = 12
If R3 = R2 Or R3 = R1 Then
For P5 = 1 To 5
E = Estratto(Es + 1,R3,P5)
If E = Met1 Or E = Met2 Then
N(1) = A : N(2) = B : N(3) = C : N(4) = D : N(5) = E
Diam_E = Diametrale(E)
Abb1 = Fuori90(E + 9)
Abb2 = Fuori90((90 + E) - 9)
Abb3 = Diam_E + 9
Abb4 = Diam_E - 9
Z(1) = Diam_E : Z(2) = Abb1 : Z(3) = Abb2 : Z(4) = Abb3 : Z(5) = Abb4
Amba(1) = Diam_E
Ambo1(1) = Diam_E : Ambo1(2) = Abb1
Ambo2(1) = Diam_E : Ambo2(2) = Abb2
Ambo3(1) = Abb1 : Ambo3(2) = Abb2
Ambo4(1) = Diam_E : Ambo4(2) = Abb3
Ambo5(1) = Diam_E : Ambo5(2) = Abb4
Terno(1) = Diam_E : Terno(2) = Abb1 : Terno(3) = Abb2
Terno2(1) = Diam_E : Terno2(2) = Abb3 : Terno2(3) = Abb4
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 2
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P6 = 1 To 5
E1 = Estratto(Es,R1,P6)
If E1 = A Or E1 = B Or E1 = C Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R2) & " ",1,0
For P7 = 1 To 5
E2 = Estratto(Es,R2,P7)
If E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es + 1) & " del " & DataEstrazione(Es + 1)),1,0
Scrivi " " & SiglaRuota(R3) & " ",1,0
For P8 = 1 To 5
E3 = Estratto(Es + 1,R3,P8)
If E3 = E Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E3) & " ",1,0
ColoreTesto 0
Next
Scrivi
If Visual = 1 Then
DisegnaCerchioCiclometrico M,1,1,,,1,1
DisegnaCerchioCiclometrico N,1,1,,,1,1
DisegnaCerchioCiclometrico Z,1,1,,,1,1
End If
Ruo(1) = R1 : Ruo(2) = R2
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = TT_
ImpostaGiocata 1,Amba,Ruo,Posta,Clp1,,1
ImpostaGiocata 2,Ambo1,Ruote,Poste,Clp2,,1
ImpostaGiocata 3,Ambo2,Ruote,Poste,Clp2,,1
ImpostaGiocata 4,Ambo3,Ruote,Poste,Clp2,,1
ImpostaGiocata 5,Ambo4,Ruote,Poste,Clp2,,1
ImpostaGiocata 6,Ambo5,Ruote,Poste,Clp2,,1
ImpostaGiocata 7,Terno,Ruote,Posts,Clp2,,1
ImpostaGiocata 8,Terno2,Ruote,Posts,Clp2,,1
Gioca Es,1
End If
Next
End If
Next
End If
End If
End If
End If
If ScriptInterrotto Then Exit Sub
Next
End If
Next
End If '----
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)
If isNumeroValidoLotto(A) Then
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 isNumeroValidoLotto(C) Then
If C <> A And C <> B And D <> A And D <> 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 = 36 Or DM12 = 9 Then
If(DM12 = 36 And DM23 = 9 And DM34 = 36 And DM41 = 9)_
Or(DM41 = 36 And DM12 = 9 And DM23 = 36 And DM34 = 9) Then
If DM12 = 36 Then
Met1 = Fuori90(M(1) + 18)
Met2 = Fuori90(M(3) + 18)
End If
If DM23 = 36 Then
Met1 = Fuori90(M(2) + 18)
Met2 = Fuori90(M(4) + 18)
End If
For R3 = 1 To 12
If R3 = 11 Then R3 = 12
If R3 = R2 Or R3 = R1 Then
For P5 = 1 To 5
E = Estratto(Es + 1,R3,P5)
If E = Met1 Or E = Met2 Then
N(1) = A : N(2) = B : N(3) = C : N(4) = D : N(5) = E
Diam_E = Diametrale(E)
Abb1 = Fuori90(E + 9)
Abb2 = Fuori90((90 + E) - 9)
Z(1) = Diam_E : Z(2) = Abb1 : Z(3) = Abb2
Amba(1) = Diam_E
Ambo1(1) = Diam_E : Ambo1(2) = Abb1
Ambo2(1) = Diam_E : Ambo2(2) = Abb2
Ambo3(1) = Abb1 : Ambo3(2) = Abb2
Terno(1) = Diam_E : Terno(2) = Abb1 : Terno(3) = Abb2
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 2
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 1
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 P6 = 1 To 5
E1 = Estratto(Es,R1,P6)
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 P7 = 1 To 5
E2 = Estratto(Es,R2,P7)
If E2 = C Or E2 = D Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E2) & " ",1,0
ColoreTesto 0
Next
Scrivi
Scrivi(" Estrazione n." & Format2(Es + 1) & " del " & DataEstrazione(Es + 1)),1,0
Scrivi " " & SiglaRuota(R3) & " ",1,0
For P8 = 1 To 5
E3 = Estratto(Es + 1,R3,P8)
If E3 = E Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E3) & " ",1,0
ColoreTesto 0
Next
Scrivi
If Visual = 1 Then
DisegnaCerchioCiclometrico M,1,1,,,1,1
DisegnaCerchioCiclometrico N,1,1,,,1,1
DisegnaCerchioCiclometrico Z,1,1,,,1,1
End If
Ruo(1) = R1 : Ruo(2) = R2
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = TT_
ImpostaGiocata 1,Amba,Ruo,Posta,Clp1,,1
ImpostaGiocata 2,Ambo1,Ruote,Poste,Clp2,,1
ImpostaGiocata 3,Ambo2,Ruote,Poste,Clp2,,1
ImpostaGiocata 4,Ambo3,Ruote,Poste,Clp2,,1
ImpostaGiocata 5,Terno,Ruote,Posts,Clp2,,1
Gioca Es,1
End If
Next
End If
Next
End If
End If
End If
End If
Next
If ScriptInterrotto Then Exit Sub
Next
Next
End If
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi TempoTrascorso
End Sub

