| 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 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 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 |
