Posts written by Unouno50

Posted: 17/6/2021, 22:03

RIKIESTA PER UNO UNO 50 - Aiuto per Listati

Grazie.

Posted: 13/6/2021, 16:06

RIKIESTA PER UNO UNO 50 - Aiuto per Listati

Ciao a Tutti

Purtroppo da una decina di giorni, ho la moglie in ospedale, e quando ho un momento libero, ho la testa altrove.

Spero che gli script te li facciano altri, io proprio non ci sto con la testa.

Posted: 2/6/2021, 10:17

Richiesta script per uno uno50 - Aiuto per Listati

Ciao a Tutti

La bomba ciclometrica

SPOILER (clicca per visualizzare)

Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,X,Clp,Es,Cer,Ok
Dim R1,R2,P1,P2,P3,P4,Salvo50,Sp,X1,X2,X3,X4
Dim DM12,DM23,DM34,DM41,Caso,Casi,Sf1,Sf2,Sf3,Sf4
Dim Amba(1),Ambo1(2),Ambo2(2),Ruo(2),Ruote(3)
Dim Po1(1),Po2(2),L(6),M(4),N1(1),N2(1),N3(1),N4(1)
Dim Ambetto1(2),Ambetto2(2),Ambetto3(2),Ambetto4(2)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9910))'9749 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(1) & "LA BOMBA CICLOMETRICA - UN SOLO AMBO SECCO di ANGELO GARGIULO - SCRIPT UNOUNO50 alias SALVO50" & Space(1),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 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 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 = 18 And DM34 = 18 And DM41 = 27 _
Or DM23 = 27 And DM34 = 18 And DM41 = 18 And DM12 = 27 _
Or DM34 = 27 And DM41 = 18 And DM12 = 18 And DM23 = 27 _
Or DM41 = 27 And DM12 = 18 And DM23 = 18 And DM34 = 27 Then
'---------------------------------
If DM12 = 27 And DM23 = 18 And DM34 = 18 And DM41 = 27 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 27 And DM34 = 18 And DM41 = 18 And DM12 = 27 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 27 And DM41 = 18 And DM12 = 18 And DM23 = 27 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 27 And DM12 = 18 And DM23 = 18 And DM34 = 27 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
N1(1) = Fuori90(L(4) + 9)
N2(1) = Fuori90(L(4) + 18)
N3(1) = Fuori90(L(1) + 9)
N4(1) = Fuori90(L(1) + 18)
Ruo(1) = R1 : Ruo(2) = R2
Sf1 = SerieFreq(Es - 5,Es,N1,Ruo,1)
Sf2 = SerieFreq(Es - 5,Es,N2,Ruo,1)
Sf3 = SerieFreq(Es - 5,Es,N3,Ruo,1)
Sf4 = SerieFreq(Es - 5,Es,N4,Ruo,1)
Ok = 0
If(Sf1 > 0 Xor Sf2 > 0) Xor(Sf3 > 0 Xor Sf4 > 0)Then
If Sf1 > 0 Then Amba(1) = N2(1) : L(5) = N1(1) : L(6) = N2(1) : Ok = 1
If Sf2 > 0 Then Amba(1) = N1(1) : L(5) = N1(1) : L(6) = N2(1) : Ok = 1
If Sf3 > 0 Then Amba(1) = N4(1) : L(5) = N3(1) : L(6) = N4(1) : Ok = 1
If Sf4 > 0 Then Amba(1) = N3(1) : L(5) = N3(1) : L(6) = N4(1) : Ok = 1
If Ok = 1 Then
If Sf1 > 0 Or Sf2 > 0 Then Ambo1(1) = N1(1) : Ambo1(2) = N2(1)
If Sf3 > 0 Or Sf4 > 0 Then Ambo1(1) = N3(1) : Ambo1(2) = N4(1)
'Ambetti
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)
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
End If
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_
Scrivi
Scrivi Space(24) & Format2(Amba(1)) & " Ambata",1,,,2
Scrivi
ImpostaGiocata 1,Amba,Ruo,Po1,5,1
ImpostaGiocata 2,Ambo1,Ruote,Po2,Clp
Gioca Es,1
Scrivi Space(24) & "AMBETTI",1,,,2
ImpostaGiocata 3,Ambetto1,Ruote,Po2,Clp
ImpostaGiocata 4,Ambetto2,Ruote,Po2,Clp
ImpostaGiocata 5,Ambetto3,Ruote,Po2,Clp
ImpostaGiocata 6,Ambetto4,Ruote,Po2,Clp
Gioca Es,1
End If
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 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 = 27 And DM23 = 18 And DM34 = 18 And DM41 = 27 _
Or DM23 = 27 And DM34 = 18 And DM41 = 18 And DM12 = 27 _
Or DM34 = 27 And DM41 = 18 And DM12 = 18 And DM23 = 27 _
Or DM41 = 27 And DM12 = 18 And DM23 = 18 And DM34 = 27 Then
'---------------------------------
If DM12 = 27 And DM23 = 18 And DM34 = 18 And DM41 = 27 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 27 And DM34 = 18 And DM41 = 18 And DM12 = 27 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 27 And DM41 = 18 And DM12 = 18 And DM23 = 27 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 27 And DM12 = 18 And DM23 = 18 And DM34 = 27 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
N1(1) = Fuori90(L(4) + 9)
N2(1) = Fuori90(L(4) + 18)
N3(1) = Fuori90(L(1) + 9)
N4(1) = Fuori90(L(1) + 18)
Ruo(1) = R1 : Ruo(2) = R2
Sf1 = SerieFreq(Es - 5,Es,N1,Ruo,1)
Sf2 = SerieFreq(Es - 5,Es,N2,Ruo,1)
Sf3 = SerieFreq(Es - 5,Es,N3,Ruo,1)
Sf4 = SerieFreq(Es - 5,Es,N4,Ruo,1)
Ok = 0
If(Sf1 > 0 Xor Sf2 > 0) Xor(Sf3 > 0 Xor Sf4 > 0)Then
If Sf1 > 0 Then Amba(1) = N2(1) : L(5) = N1(1) : L(6) = N2(1) : Ok = 1
If Sf2 > 0 Then Amba(1) = N1(1) : L(5) = N1(1) : L(6) = N2(1) : Ok = 1
If Sf3 > 0 Then Amba(1) = N4(1) : L(5) = N3(1) : L(6) = N4(1) : Ok = 1
If Sf4 > 0 Then Amba(1) = N3(1) : L(5) = N3(1) : L(6) = N4(1) : Ok = 1
If Ok = 1 Then
If Sf1 > 0 Or Sf2 > 0 Then Ambo1(1) = N1(1) : Ambo1(2) = N2(1)
If Sf3 > 0 Or Sf4 > 0 Then Ambo1(1) = N3(1) : Ambo1(2) = N4(1)
'Ambetti
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)
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
Ruote(1) = R1 : Ruote(2) = R2 : Ruote(3) = NZ_
Scrivi
Scrivi Space(24) & Format2(Amba(1)) & " Ambata",1,,,2
Scrivi
ImpostaGiocata 1,Amba,Ruo,Po1,5,1
ImpostaGiocata 2,Ambo1,Ruote,Po2,Clp
Gioca Es,1
Scrivi Space(24) & "AMBETTI",1,,,2
ImpostaGiocata 3,Ambetto1,Ruote,Po2,Clp
ImpostaGiocata 4,Ambetto2,Ruote,Po2,Clp
ImpostaGiocata 5,Ambetto3,Ruote,Po2,Clp
ImpostaGiocata 6,Ambetto4,Ruote,Po2,Clp
Gioca Es,1
End If
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

Posted: 30/5/2021, 18:09

Richiesta script per uno uno50 - Aiuto per Listati

Ciao Dragonzf Zf, quello chiusura 69 è unico, cioè se la chiusura è 69 i numeri devono essere sempre gli stessi, e penso che in tutte le estrazioni non ce ne saranno molte, quindi mi sono permesso di fare CHIUSURA X quello che viene, viene, la chiusura è il vertice del triangolo finale, lo script per questo metodo l'avevo già fatto, quindi lo posto, il secondo metodo quello della bomba ciclometrica lo devo fare non è pronto

SPOILER (clicca per visualizzare)

Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,X,Clp,Es,Cer
Dim R1,R2,P1,P2,P3,P4,Salvo50,Sp
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),N(3),Ruote(4)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9768))'9768 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) & "CHIUSURA X di ANGELO GARGIULO - SCRIPT UNOUNO50 alias SALVO50" & Space(14),1,,4,,3,,1
Po1(1) = 1
Po2(2) = 1
Po3(2) = 1
'Po3(3) = 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 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 = 45 And DM23 = 9 And DM34 = 9 And DM41 = 27 _
Or DM23 = 45 And DM34 = 9 And DM41 = 9 And DM12 = 27 _
Or DM34 = 45 And DM41 = 9 And DM12 = 9 And DM23 = 27 _
Or DM41 = 45 And DM12 = 9 And DM23 = 9 And DM34 = 27 Then
'---------------------------------
If DM12 = 45 And DM23 = 9 And DM34 = 9 And DM41 = 27 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 45 And DM34 = 9 And DM41 = 9 And DM12 = 27 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 45 And DM41 = 9 And DM12 = 9 And DM23 = 27 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 45 And DM12 = 9 And DM23 = 9 And DM34 = 27 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
L(5) = Fuori90((90 + L(1)) - 9)
L(6) = Fuori90(L(5) + 18)
N(1) = Fuori90((90 + L(5)) - 9)
N(2) = Fuori90((90 + N(1)) - 36)
N(3) = Fuori90(N(1) + 36)
Amba(1) = N(1)
Ambo1(1) = N(1): Ambo1(2) = N(2)
Ambo2(1) = N(1): Ambo2(2) = N(3)
Terna(1) = N(1): Terna(2) = N(2): Terna(3) = N(3)
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(N(1)) & " Ambata",1,,,2
Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1
Scrivi Space(25) & Format2(N(2)) & Sp & Format2(N(3)),1
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,1
ImpostaGiocata 2,Ambo1,Ruo,Po2,Clp
ImpostaGiocata 3,Ambo2,Ruo,Po2,Clp
ImpostaGiocata 4,Terna,Ruote,Po3,Clp
Gioca Es,1
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 = 45 And DM23 = 9 And DM34 = 9 And DM41 = 27 _
Or DM23 = 45 And DM34 = 9 And DM41 = 9 And DM12 = 27 _
Or DM34 = 45 And DM41 = 9 And DM12 = 9 And DM23 = 27 _
Or DM41 = 45 And DM12 = 9 And DM23 = 9 And DM34 = 27 Then
'---------------------------------
If DM12 = 45 And DM23 = 9 And DM34 = 9 And DM41 = 27 Then
L(1) = M(1) : L(2) = M(2) : L(3) = M(3) : L(4) = M(4)
End If
If DM23 = 45 And DM34 = 9 And DM41 = 9 And DM12 = 27 Then
L(1) = M(2) : L(2) = M(3) : L(3) = M(4) : L(4) = M(1)
End If
If DM34 = 45 And DM41 = 9 And DM12 = 9 And DM23 = 27 Then
L(1) = M(3) : L(2) = M(4) : L(3) = M(1) : L(4) = M(2)
End If
If DM41 = 45 And DM12 = 9 And DM23 = 9 And DM34 = 27 Then
L(1) = M(4) : L(2) = M(1) : L(3) = M(2) : L(4) = M(3)
End If
L(5) = Fuori90((90 + L(1)) - 9)
L(6) = Fuori90(L(5) + 18)
N(1) = Fuori90((90 + L(5)) - 9)
N(2) = Fuori90((90 + N(1)) - 36)
N(3) = Fuori90(N(1) + 36)
Amba(1) = N(1)
Ambo1(1) = N(1): Ambo1(2) = N(2)
Ambo2(1) = N(1): Ambo2(2) = N(3)
Terna(1) = N(1): Terna(2) = N(2): Terna(3) = N(3)
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(N(1)) & " Ambata",1,,,2
Scrivi Space(17) & " Abbinamenti Per Ambo ",1,,,1
Scrivi Space(25) & Format2(N(2)) & Sp & Format2(N(3)),1
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,1
ImpostaGiocata 2,Ambo1,Ruo,Po2,Clp
ImpostaGiocata 3,Ambo2,Ruo,Po2,Clp
ImpostaGiocata 4,Terna,Ruote,Po3,Clp
Gioca Es,1
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

Edited by Unouno50 - 30/5/2021, 20:09

Posted: 10/5/2021, 23:21

Chi mi Aiuta Vince - Aiuto per Listati

Ciao a Tutti.

Ciao SimoRocket, nel mio secondo post, quello delle 17,29 del 21-04-21 apri lo spoiler, c'è lo script modificato.

Praticamente ho tolto quello sbagliato e al suo posto ho messo quello modificato

Posted: 6/5/2021, 12:33

Chi mi Aiuta Vince - Aiuto per Listati

Chiedo scusa per l'errore commesso, un grazie ad Enplein che me lo ha fatto notare.

Ho modificato lo script, quindi è da riprendere

Posted: 6/5/2021, 07:52

Chi mi Aiuta Vince - Aiuto per Listati

Ciao a Tutti.
Ciao Enplein

Premetto che tu insieme a LuigiB, Joe, Mike58, ILegend, Claudio8, Cinzia, Magia, Master ecc..., vi considero come miei maestri.

Se facciamo i calcoli come proponi tu è vero non ci sono numeri fissi, ma quell'espressione che ho citato prima non me la sono inventata io, è nell'articolo

MASI1

e come ho scritto prima, qualunque numero metti al posto del 27 il risultato è sempre 90

ragionando con il tuo esempio mi accorgo che l'espressione come è presentata è molto ambigua.

Comunque ti ringrazio del tuo intervento e il prima possibile correggerò lo script

Posted: 21/4/2021, 16:29

Chi mi Aiuta Vince - Aiuto per Listati

Ciao a Tutti.

Credo che in questo articolo ci siano un bel po' di errori di stampa, altrimenti la quaterna 27-54-45-90 non è pronosticata, infatti
masi3

Il secondo 54 col circolettato deve essere 45, anche il 90 sotto deve essere 45, perchè i 4 numeri della seconda quaterna sono i diametrali della prima quaterna, nelle 2 quaterne pronosticate non c'è la Quaterna a meno che non si invertiscono di posto 81 con il 45.

Il controllo nelle 30 estrazioni a ritroso dato che non è specificato come farlo, l'ho fatto con lunghetta di 7 numeri non ci deve essere il terno nelle 30 estrazioni a ritroso

Riguardo ai numeri fissi mi sono sbagliato perchè ho interpretato male questo procedimento

MASI1

Come mi ha fatto notare Enplein

Quindi ho modificato lo script, però dato che (secondo me) la quaterna nelle quartine pronosticate non c'è, ho inserito nel pronostico anche la lunghetta, per ambo terno e quaterna, infatti la quaterna pronosticata si trova nella lunghetta (7 numeri)

sperando di non aver fatto errori

Ecco lo script, modificato

SPOILER (clicca per visualizzare)

Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,Clp,Es,Sp
Dim R1,R2,P1,P2,P3,P4,Unouno50,S1,DiamS1
Dim FA,FB,FAB,SAB,DiCap12,SoCap12,Caso,Casi,Ok
Dim DiamSab,DiamFab,DiamSoCap12,Elem23,DiamElem23
Dim Ambo1(2),Ambo2(2),Ambo3(2),Qua1(4),Qua2(4)
Dim Post1(2),Post2(4),Ruo(2),Num(7)
FIn = EstrazioneFin
Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Unouno50,9870))
Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Unouno50,9))
Call ScegliRange(Ini,FIn,Ini,FIn)
Scrivi Space(9) & "Ambo Ripetuto di Elisabetta Masi - Script Unouno50 (Alias Salvo50)" & Space(10),1,,4,,3,,1
Post1(2) = 1
Post2(2) = 1
Post2(3) = 1
Post2(4) = 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 B = D Then
FA = Figura(A) : FB = Figura(B)
FAB = CInt(FA & FB) : FAB = Fuori90(FAB)
SAB = Fuori90(A + B)
If FAB <> SAB Then
DiCap12 = Distanza(FAB,SAB)'DIST CICLOMETRICA
SoCap12 = Fuori90(FAB + SAB)
S1 = Fuori90(DiCap12 + SAB)
DiamS1 = Diametrale(S1)
DiamSab = Diametrale(SAB)
DiamFab = Diametrale(FAB)
DiamSoCap12 = Diametrale(SoCap12)
Elem23 = Fuori90((FAB + 90) - DiCap12)
DiamElem23 = Diametrale(Elem23)
Num(1) = A : Num(2) = B : Num(3) = FAB : Num(4) = SAB
Num(5) = DiamElem23 : Num(6) = SoCap12 : Num(7) = Elem23
Ruo(1) = R1 : Ruo(2) = R2
If SerieFreqTurbo(Es - 30,Es - 1,Num,Ruo,3) = 0 Then
Ambo1(1) = FAB : Ambo1(2) = SAB
Ambo2(1) = SAB : Ambo2(2) = S1
Ambo3(1) = FAB : Ambo3(2) = Elem23
If FAB <> S1 And FAB <> Elem23 And SAB <> S1 And SAB <> Elem23 Then
Qua1(1) = FAB : Qua1(2) = SAB : Qua1(3) = S1 : Qua1(4) = Elem23
Qua2(1) = DiamFab : Qua2(2) = DiamSab : Qua2(3) = DiamS1 : Qua2(4) = DiamElem23
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(17) & "La Figura di " & Format2(A) & " = " & FA,1,0
Scrivi Space(11) & "La Figura di " & Format2(B) & " = " & FB,1
Scrivi Space(10) & "Unione delle 2 figure = " & Format2(FAB),1,0
Scrivi Space(7) & "<-- 1° Capogioco e 1° Elemento 1° Ambo",1
Scrivi Space(10) & "Estratto " & Format2(A) & " + " & "Estratto ",1,0
Scrivi Format2(B) & " = " & Format2(SAB) & " <-- 2° Capogioco e 2° Elemento 1° Ambo",1
Scrivi Space(10) & "La Distanza Ciclometrica tra " & Format2(SAB) & " e ",1,0
Scrivi Format2(FAB) & " = " & Format2(DiCap12),1 ' & Space(6) & " <-- 1° Elemento 3° Ambo",1
Scrivi Space(10) & "La Somma tra " & Space(16) & Format2(SAB) & " e ",1,0
Scrivi Format2(DiCap12) & " = " & Format2(S1) & Space(6) & " <-- 2° Elemento 2° Ambo",1
Scrivi Space(10) & "Il Primo Capog. " & Format2(FAB) & " - Dist. Ciclo " & Format2(DiCap12) & " = ",1,0
Scrivi Format2(Elem23) & Space(7) & "<-- 2° Elemento 3° Ambo",1
Scrivi
Scrivi Space(10) & "I Diametrali della Quartina " & StringaNumeri(Qua1," ",True),1,0
Scrivi " sono " & StringaNumeri(Qua2," ",True),1
Scrivi
Scrivi Space(25) & " Pronostico Per " & NomeRuota(R1) & " e " & NomeRuota(R2),1,,,1
Scrivi Space(24) & "Ambi Secchi " & Format2(FAB) & Sp & Format2(SAB),1,0
Scrivi Space(4) & Format2(SAB) & Sp & Format2(S1) & Space(4) & Format2(FAB) & Sp,1,0
Scrivi Format2(Elem23),1
Scrivi Space(15) & " Per Ambo e Terno e Quaterna " & StringaNumeri(Num," ",True),1
Scrivi Space(26) & " Per Ambo e Terno e Quaterna",1,,,2
Scrivi Space(28) & StringaNumeri(Qua1," ",True) & Space(5) & StringaNumeri(Qua2," ",True),1
Scrivi
ImpostaGiocata 1,Ambo1,Ruo,Post1,Clp
ImpostaGiocata 2,Ambo2,Ruo,Post1,Clp
ImpostaGiocata 3,Ambo3,Ruo,Post1,Clp
ImpostaGiocata 4,Qua1,Ruo,Post2,Clp
ImpostaGiocata 5,Qua2,Ruo,Post2,Clp
ImpostaGiocata 6,Num,Ruo,Post2,Clp
Gioca Es,1
End If
End If
End If
End If
End If
Next
Next
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
End Sub

Edited by Unouno50 - 11/5/2021, 00:29

Posted: 20/4/2021, 10:06

Chi mi Aiuta Vince - Aiuto per Listati

Ciao a Tutti.

Non sai da dove iniziare a fare gli script, ma a leggere le istruzioni puoi farlo, e se leggi le istruzioni ti accorgi che nella "Favolosa Quaterna" ci sono 2 numeri fissi, il 90 ed il 45.

L'autrice fa questi calcoli

27 + 90 = 117
117 - 27 = 90

Ma in questo modo qualunque numero metti al posto del 27, il risultato sarà sempre 90, ecco perche dico che il 90 è un numero fisso, poi dice di abbinare anche i diametrali quindi dato che il 45 è il diametrale di 90, ecco che 45 e 90 sono numeri fissi, se il mio discorso non fila fatemi sapere dove sto sbagliando

Posted: 12/4/2021, 12:40

script - Aiuto per Listati

Ciao a Tutti.

Ho fatto 2 script, uno libero da filtri, senza rispettare tra i due ambi la stessa distanza oppure la somma, perchè ho notato che di riscontri vincenti anche con terni ce ne sono anche cosi.

Quindi nel primo ho impostato che i due ambi devono avere la somma uguale, come da esempio.

Poi nei due script alle domande:

1ª Inserire il numero dell'estrazione iniziale
2ª Inserire per quanti colpi giocare il pronostico
3ª Inserire quante estrazioni andare a ritroso per cercare il 2° ambo, se si imposta 0 (zero) la ricerca del secondo ambo viene fatta nella stessa estrazione del primo ambo
4ª Inserire il numero 1 se si vuole vedere nell'output la figura dei Cerchi Ciclometrici, altrimenti se non si vogliono vedere inserire un qualsiasi altro numero.

Ecco gli script salvo errori o dimenticanze

script con somme uguali

SPOILER (clicca per visualizzare)

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,9850))'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(

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

script libero da filtri

SPOILER (clicca per visualizzare)

Option Explicit
Sub Main
Dim FIn,Ini,A,B,C,D,Clp,Es,Es2,Cer,E1,E2,x
Dim R1,R2,P1,P2,P3,P4,P5,P6,Unouno50,g
Dim DM12,DM23,DM34,DM41,Caso,Casi,Ind
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,9860))
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,0))
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(9) & "Per Dragonzf - Metodo di Noel - Script Unouno50 (Alias Salvo50)" & Space(9),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)
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)
If A > 0 And D > 0 Then
If A <> C And A <> B 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,,,1
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " ",1,0
For P5 = 1 To 5
E1 = Estratto(Es,R1,P5)
If E1 = A Or E1 = B Then
ColoreTesto 2
Else
ColoreTesto 0
End If
Scrivi Format2(E1) & " ",1,0
ColoreTesto 0
Next
Scrivi
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
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(

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

10 replies since 3/1/2020

Filter forums