Salve a tutti del forum, in questi giorni ho studiato un metodo per ambo in quartina su due ruote, in realtà il metodo sarebbe per il 10e lotto che per sola ambata ha una forte probabilità entro tre massimo 4 colpi, però l'ho adattato per il gioco del lotto, non essendo un mago degli script, mi son fatto aiutare dalla AI PER SCRIVERLO e ora ve lo propongo
Sub Main
Dim Inizio,Fine,Estrazione,Colpo
Dim PosA,PosB,PosC,PosD,Num1,Num2
Dim R1,R2,TotalePrevisioni
Dim ContaElementi,i,j,ScegliIndice,QtaEstrazioni,ColpiGioco
Dim R1_Tab(1000),P1A_Tab(1000),P1B_Tab(1000)
Dim R2_Tab(1000),P2A_Tab(1000),P2B_Tab(1000)
Dim Vincenti_Tab(1000),Perc_Tab(1000)
Dim TempR1,TempP1A,TempP1B,TempR2,TempP2A,TempP2B,TempVinc,TempPerc
Dim Ambata1,Ambata2,UltimaEstrazioneValida
Dim RuoteVerifica(2),NumeriAmbo(4)
Dim LimiteVisualizzazione
Dim EstrattoFinUltimo,RuotaVer,EstrVer,ColpoVer,TrovatoAmbo
Dim P_Ambata1,P_Ambata2,V_Ambata1,V_Ambata2
Dim RuotaTestSingola(1)
' Popup di controllo completi
ScegliIndice = CInt(InputBox("Inserisci l'indice mensile da analizzare (es. 9 = 9ª del mese, 0=Tutte):", "FILTRO INDICE MENSILE", 9))
QtaEstrazioni = CInt(InputBox("Quante estrazioni storiche vuoi analizzare a ritroso?", "PROFONDITÀ STATISTICA", 150))
ColpiGioco = CInt(InputBox("Inserisci il numero di colpi di gioco da testare (da 1 a 18):", "CICLO DI GIOCO DINAMICO", 9))
' Sicurezza per evitare sforamenti d'archivio eccessivi
If ColpiGioco < 1 Then ColpiGioco = 1
If ColpiGioco > 18 Then ColpiGioco = 18
Inizio = EstrazioneFin - QtaEstrazioni
Fine = EstrazioneFin
EstrattoFinUltimo = EstrazioneFin
Scrivi "=== ANALIZZATORE AUTOMATICO COPPIA RUOTE - RANGE COLPI PERSONALIZZATO ===", 1, , vbBlue, vbWhite
Scrivi "Calcolo: Screening automatico con verifica esiti su 2 ruote per " & ColpiGioco & " COLPI SUCC.", 1, , vbBlack, vbYellow
Scrivi "Formula: Elezione del Minore meno Maggiore e fuori 90 inverso con Vertibili", 1
Scrivi "--------------------------------------------------------------------------------"
ContaElementi = 0
For R1 = 1 To 9
For PosA = 1 To 4
For PosB = PosA + 1 To 5
For R2 = R1 + 1 To 10
For PosC = 1 To 4
For PosD = PosC + 1 To 5
If ContaElementi < 950 Then
ContaElementi = ContaElementi + 1
R1_Tab(ContaElementi) = R1
P1A_Tab(ContaElementi) = PosA
P1B_Tab(ContaElementi) = PosB
R2_Tab(ContaElementi) = R2
P2A_Tab(ContaElementi) = PosC
P2B_Tab(ContaElementi) = PosD
Vincenti_Tab(ContaElementi) = 0
Perc_Tab(ContaElementi) = 0
End If
Next
Next
Next
Next
Next
Next
TotalePrevisioni = 0
UltimaEstrazioneValida = 0
' --- FASE 1: Calcolo Statistico filtrato sulle 2 ruote (Ciclo Dinamico) ---
For Estrazione = Inizio To Fine
If ScegliIndice = 0 Or IndiceMensile(Estrazione) = ScegliIndice Then
TotalePrevisioni = TotalePrevisioni + 1
UltimaEstrazioneValida = Estrazione
For i = 1 To ContaElementi
Num1 = Estratto(Estrazione, R1_Tab(i), P1A_Tab(i))
Num2 = Estratto(Estrazione, R1_Tab(i), P1B_Tab(i))
If Num1 > 0 And Num2 > 0 Then
If Num1 < Num2 Then Ambata1 = Num1 - Num2 Else Ambata1 = Num2 - Num1
Ambata1 = Ambata1 + 90
Num1 = Estratto(Estrazione, R2_Tab(i), P2A_Tab(i))
Num2 = Estratto(Estrazione, R2_Tab(i), P2B_Tab(i))
If Num1 > 0 And Num2 > 0 Then
If Num1 < Num2 Then Ambata2 = Num1 - Num2 Else Ambata2 = Num2 - Num1
Ambata2 = Ambata2 + 90
If Ambata1 <> Ambata2 Then
NumeriAmbo(1) = Ambata1
NumeriAmbo(2) = Vert(Ambata1)
NumeriAmbo(3) = Ambata2
NumeriAmbo(4) = Vert(Ambata2)
RuoteVerifica(1) = R1_Tab(i)
RuoteVerifica(2) = R2_Tab(i)
' Range di colpi impostato dinamicamente dall'utente
For Colpo = 1 To ColpiGioco
If SerieFreq(Estrazione + Colpo, Estrazione + Colpo, NumeriAmbo, RuoteVerifica, 2) > 0 Then
Vincenti_Tab(i) = Vincenti_Tab(i) + 1
Exit For
End If
Next
End If
End If
End If
Next
End If
Next
For i = 1 To ContaElementi
If TotalePrevisioni > 0 Then
Perc_Tab(i) = (Vincenti_Tab(i) / TotalePrevisioni) * 100
End If
Next
' --- FASE 2: Ordinamento Classifica ---
For i = 1 To ContaElementi - 1
For j = i + 1 To ContaElementi
If Perc_Tab(j) > Perc_Tab(i) Then
TempPerc = Perc_Tab(i) : Perc_Tab(i) = Perc_Tab(j) : Perc_Tab(j) = TempPerc
TempVinc = Vincenti_Tab(i) : Vincenti_Tab(i) = Vincenti_Tab(j) : Vincenti_Tab(j) = TempVinc
TempR1 = R1_Tab(i) : R1_Tab(i) = R1_Tab(j) : R1_Tab(j) = TempR1
TempP1A = P1A_Tab(i) : P1A_Tab(i) = P1A_Tab(j) : P1A_Tab(j) = TempP1A
TempP1B = P1B_Tab(i) : P1B_Tab(i) = P1B_Tab(j) : P1B_Tab(j) = TempP1B
TempR2 = R2_Tab(i) : R2_Tab(i) = R2_Tab(j) : R2_Tab(j) = TempR2
TempP2A = P2A_Tab(i) : P2A_Tab(i) = P2A_Tab(j) : P2A_Tab(j) = TempP2A
TempP2B = P2B_Tab(i) : P2B_Tab(i) = P2B_Tab(j) : P2B_Tab(j) = TempP2B
End If
Next
Next
' --- FASE 3: Output e Sviluppo del Pronostico ---
Scrivi "TOP 15 STRUTTURE PIU VINCENTI SULLE PROPRIE 2 RUOTE (SU " & ColpiGioco & " COLPI):", 1, , vbYellow, vbBlack
If ContaElementi < 15 Then LimiteVisualizzazione = ContaElementi Else LimiteVisualizzazione = 15
For i = 1 To LimiteVisualizzazione
Scrivi "Gioca su [" & NomeRuota(R1_Tab(i)) & "-" & NomeRuota(R2_Tab(i)) & "] -> [" & NomeRuota(R1_Tab(i)) & " " & P1A_Tab(i) & "-" & P1B_Tab(i) & "] CON [" & NomeRuota(R2_Tab(i)) & " " & P2A_Tab(i) & "-" & P2B_Tab(i) & "] -> Vincenti: " & Vincenti_Tab(i) & " (" & Round(Perc_Tab(i), 2) & "%)", 1, , vbGreen, vbBlack
Next
Scrivi
Scrivi "=== SVILUPPO PRONOSTICO AUTOMATICO IN QUARTINA ===", 1, , vbRed, vbWhite
Scrivi "Estrazione calcolo n°: " & UltimaEstrazioneValida & " del " & DataEstrazione(UltimaEstrazioneValida) & " (Indice Mensile: " & IndiceMensile(UltimaEstrazioneValida) & ")", 1
If ContaElementi > 0 Then
Num1 = Estratto(UltimaEstrazioneValida, R1_Tab(1), P1A_Tab(1))
Num2 = Estratto(UltimaEstrazioneValida, R1_Tab(1), P1B_Tab(1))
If Num1 < Num2 Then P_Ambata1 = Num1 - Num2 Else P_Ambata1 = Num2 - Num1
P_Ambata1 = P_Ambata1 + 90 : V_Ambata1 = Vert(P_Ambata1)
Num1 = Estratto(UltimaEstrazioneValida, R2_Tab(1), P2A_Tab(1))
Num2 = Estratto(UltimaEstrazioneValida, R2_Tab(1), P2B_Tab(1))
If Num1 < Num2 Then P_Ambata2 = Num1 - Num2 Else P_Ambata2 = Num2 - Num1
P_Ambata2 = P_Ambata2 + 90 : V_Ambata2 = Vert(P_Ambata2)
Scrivi "LE 2 RUOTE UNICHE DI GIOCO REALE: " & NomeRuota(R1_Tab(1)) & " e " & NomeRuota(R2_Tab(1)), 1, , vbBlack, vbYellow
Scrivi "QUARTINA DA METTERE IN GIOCO (Ciclo impostato " & ColpiGioco & " colpi): " & P_Ambata1 & " - " & V_Ambata1 & " - " & P_Ambata2 & " - " & V_Ambata2, 1, , vbYellow, vbRed
Scrivi "--------------------------------------------------------------------------------"
Scrivi "VERIFICA SFALDAMENTO REALE NEI " & ColpiGioco & " COLPI SUCCESSIVI:", 1
TrovatoAmbo = False
NumeriAmbo(1) = P_Ambata1 : NumeriAmbo(2) = V_Ambata1
NumeriAmbo(3) = P_Ambata2 : NumeriAmbo(4) = V_Ambata2
ColpoVer = 0
' Allineamento dinamico della verifica finale visiva
Dim FineVerifica
FineVerifica = UltimaEstrazioneValida + ColpiGioco
If FineVerifica > EstrattoFinUltimo Then FineVerifica = EstrattoFinUltimo
For EstrVer = (UltimaEstrazioneValida + 1) To FineVerifica
ColpoVer = ColpoVer + 1
RuoteVerifica(1) = R1_Tab(1)
RuoteVerifica(2) = R2_Tab(1)
For j = 1 To 2
RuotaTestSingola(1) = RuoteVerifica(j)
If SerieFreq(EstrVer, EstrVer, NumeriAmbo, RuotaTestSingola, 2) > 0 Then
Scrivi "-> COLPO " & ColpoVer & " (" & DataEstrazione(EstrVer) & "): !!! AMBO IN QUARTINA COLPITO !!! su " & NomeRuota(RuoteVerifica(j)), 1, , vbGreen, vbWhite
TrovatoAmbo = True
End If
Next
Next
If TrovatoAmbo = False Then
Scrivi "Esito nei colpi controllati: Nessun sfaldamento rilevato nelle estrazioni impostate.", 1, , vbCyan, vbBlack
End If
End If
Scrivi "Fine elaborazione.", 1
End Sub
Sub Main
Dim Inizio,Fine,Estrazione,Colpo
Dim PosA,PosB,PosC,PosD,Num1,Num2
Dim R1,R2,TotalePrevisioni
Dim ContaElementi,i,j,ScegliIndice,QtaEstrazioni,ColpiGioco
Dim R1_Tab(1000),P1A_Tab(1000),P1B_Tab(1000)
Dim R2_Tab(1000),P2A_Tab(1000),P2B_Tab(1000)
Dim Vincenti_Tab(1000),Perc_Tab(1000)
Dim TempR1,TempP1A,TempP1B,TempR2,TempP2A,TempP2B,TempVinc,TempPerc
Dim Ambata1,Ambata2,UltimaEstrazioneValida
Dim RuoteVerifica(2),NumeriAmbo(4)
Dim LimiteVisualizzazione
Dim EstrattoFinUltimo,RuotaVer,EstrVer,ColpoVer,TrovatoAmbo
Dim P_Ambata1,P_Ambata2,V_Ambata1,V_Ambata2
Dim RuotaTestSingola(1)
' Popup di controllo completi
ScegliIndice = CInt(InputBox("Inserisci l'indice mensile da analizzare (es. 9 = 9ª del mese, 0=Tutte):", "FILTRO INDICE MENSILE", 9))
QtaEstrazioni = CInt(InputBox("Quante estrazioni storiche vuoi analizzare a ritroso?", "PROFONDITÀ STATISTICA", 150))
ColpiGioco = CInt(InputBox("Inserisci il numero di colpi di gioco da testare (da 1 a 18):", "CICLO DI GIOCO DINAMICO", 9))
' Sicurezza per evitare sforamenti d'archivio eccessivi
If ColpiGioco < 1 Then ColpiGioco = 1
If ColpiGioco > 18 Then ColpiGioco = 18
Inizio = EstrazioneFin - QtaEstrazioni
Fine = EstrazioneFin
EstrattoFinUltimo = EstrazioneFin
Scrivi "=== ANALIZZATORE AUTOMATICO COPPIA RUOTE - RANGE COLPI PERSONALIZZATO ===", 1, , vbBlue, vbWhite
Scrivi "Calcolo: Screening automatico con verifica esiti su 2 ruote per " & ColpiGioco & " COLPI SUCC.", 1, , vbBlack, vbYellow
Scrivi "Formula: Elezione del Minore meno Maggiore e fuori 90 inverso con Vertibili", 1
Scrivi "--------------------------------------------------------------------------------"
ContaElementi = 0
For R1 = 1 To 9
For PosA = 1 To 4
For PosB = PosA + 1 To 5
For R2 = R1 + 1 To 10
For PosC = 1 To 4
For PosD = PosC + 1 To 5
If ContaElementi < 950 Then
ContaElementi = ContaElementi + 1
R1_Tab(ContaElementi) = R1
P1A_Tab(ContaElementi) = PosA
P1B_Tab(ContaElementi) = PosB
R2_Tab(ContaElementi) = R2
P2A_Tab(ContaElementi) = PosC
P2B_Tab(ContaElementi) = PosD
Vincenti_Tab(ContaElementi) = 0
Perc_Tab(ContaElementi) = 0
End If
Next
Next
Next
Next
Next
Next
TotalePrevisioni = 0
UltimaEstrazioneValida = 0
' --- FASE 1: Calcolo Statistico filtrato sulle 2 ruote (Ciclo Dinamico) ---
For Estrazione = Inizio To Fine
If ScegliIndice = 0 Or IndiceMensile(Estrazione) = ScegliIndice Then
TotalePrevisioni = TotalePrevisioni + 1
UltimaEstrazioneValida = Estrazione
For i = 1 To ContaElementi
Num1 = Estratto(Estrazione, R1_Tab(i), P1A_Tab(i))
Num2 = Estratto(Estrazione, R1_Tab(i), P1B_Tab(i))
If Num1 > 0 And Num2 > 0 Then
If Num1 < Num2 Then Ambata1 = Num1 - Num2 Else Ambata1 = Num2 - Num1
Ambata1 = Ambata1 + 90
Num1 = Estratto(Estrazione, R2_Tab(i), P2A_Tab(i))
Num2 = Estratto(Estrazione, R2_Tab(i), P2B_Tab(i))
If Num1 > 0 And Num2 > 0 Then
If Num1 < Num2 Then Ambata2 = Num1 - Num2 Else Ambata2 = Num2 - Num1
Ambata2 = Ambata2 + 90
If Ambata1 <> Ambata2 Then
NumeriAmbo(1) = Ambata1
NumeriAmbo(2) = Vert(Ambata1)
NumeriAmbo(3) = Ambata2
NumeriAmbo(4) = Vert(Ambata2)
RuoteVerifica(1) = R1_Tab(i)
RuoteVerifica(2) = R2_Tab(i)
' Range di colpi impostato dinamicamente dall'utente
For Colpo = 1 To ColpiGioco
If SerieFreq(Estrazione + Colpo, Estrazione + Colpo, NumeriAmbo, RuoteVerifica, 2) > 0 Then
Vincenti_Tab(i) = Vincenti_Tab(i) + 1
Exit For
End If
Next
End If
End If
End If
Next
End If
Next
For i = 1 To ContaElementi
If TotalePrevisioni > 0 Then
Perc_Tab(i) = (Vincenti_Tab(i) / TotalePrevisioni) * 100
End If
Next
' --- FASE 2: Ordinamento Classifica ---
For i = 1 To ContaElementi - 1
For j = i + 1 To ContaElementi
If Perc_Tab(j) > Perc_Tab(i) Then
TempPerc = Perc_Tab(i) : Perc_Tab(i) = Perc_Tab(j) : Perc_Tab(j) = TempPerc
TempVinc = Vincenti_Tab(i) : Vincenti_Tab(i) = Vincenti_Tab(j) : Vincenti_Tab(j) = TempVinc
TempR1 = R1_Tab(i) : R1_Tab(i) = R1_Tab(j) : R1_Tab(j) = TempR1
TempP1A = P1A_Tab(i) : P1A_Tab(i) = P1A_Tab(j) : P1A_Tab(j) = TempP1A
TempP1B = P1B_Tab(i) : P1B_Tab(i) = P1B_Tab(j) : P1B_Tab(j) = TempP1B
TempR2 = R2_Tab(i) : R2_Tab(i) = R2_Tab(j) : R2_Tab(j) = TempR2
TempP2A = P2A_Tab(i) : P2A_Tab(i) = P2A_Tab(j) : P2A_Tab(j) = TempP2A
TempP2B = P2B_Tab(i) : P2B_Tab(i) = P2B_Tab(j) : P2B_Tab(j) = TempP2B
End If
Next
Next
' --- FASE 3: Output e Sviluppo del Pronostico ---
Scrivi "TOP 15 STRUTTURE PIU VINCENTI SULLE PROPRIE 2 RUOTE (SU " & ColpiGioco & " COLPI):", 1, , vbYellow, vbBlack
If ContaElementi < 15 Then LimiteVisualizzazione = ContaElementi Else LimiteVisualizzazione = 15
For i = 1 To LimiteVisualizzazione
Scrivi "Gioca su [" & NomeRuota(R1_Tab(i)) & "-" & NomeRuota(R2_Tab(i)) & "] -> [" & NomeRuota(R1_Tab(i)) & " " & P1A_Tab(i) & "-" & P1B_Tab(i) & "] CON [" & NomeRuota(R2_Tab(i)) & " " & P2A_Tab(i) & "-" & P2B_Tab(i) & "] -> Vincenti: " & Vincenti_Tab(i) & " (" & Round(Perc_Tab(i), 2) & "%)", 1, , vbGreen, vbBlack
Next
Scrivi
Scrivi "=== SVILUPPO PRONOSTICO AUTOMATICO IN QUARTINA ===", 1, , vbRed, vbWhite
Scrivi "Estrazione calcolo n°: " & UltimaEstrazioneValida & " del " & DataEstrazione(UltimaEstrazioneValida) & " (Indice Mensile: " & IndiceMensile(UltimaEstrazioneValida) & ")", 1
If ContaElementi > 0 Then
Num1 = Estratto(UltimaEstrazioneValida, R1_Tab(1), P1A_Tab(1))
Num2 = Estratto(UltimaEstrazioneValida, R1_Tab(1), P1B_Tab(1))
If Num1 < Num2 Then P_Ambata1 = Num1 - Num2 Else P_Ambata1 = Num2 - Num1
P_Ambata1 = P_Ambata1 + 90 : V_Ambata1 = Vert(P_Ambata1)
Num1 = Estratto(UltimaEstrazioneValida, R2_Tab(1), P2A_Tab(1))
Num2 = Estratto(UltimaEstrazioneValida, R2_Tab(1), P2B_Tab(1))
If Num1 < Num2 Then P_Ambata2 = Num1 - Num2 Else P_Ambata2 = Num2 - Num1
P_Ambata2 = P_Ambata2 + 90 : V_Ambata2 = Vert(P_Ambata2)
Scrivi "LE 2 RUOTE UNICHE DI GIOCO REALE: " & NomeRuota(R1_Tab(1)) & " e " & NomeRuota(R2_Tab(1)), 1, , vbBlack, vbYellow
Scrivi "QUARTINA DA METTERE IN GIOCO (Ciclo impostato " & ColpiGioco & " colpi): " & P_Ambata1 & " - " & V_Ambata1 & " - " & P_Ambata2 & " - " & V_Ambata2, 1, , vbYellow, vbRed
Scrivi "--------------------------------------------------------------------------------"
Scrivi "VERIFICA SFALDAMENTO REALE NEI " & ColpiGioco & " COLPI SUCCESSIVI:", 1
TrovatoAmbo = False
NumeriAmbo(1) = P_Ambata1 : NumeriAmbo(2) = V_Ambata1
NumeriAmbo(3) = P_Ambata2 : NumeriAmbo(4) = V_Ambata2
ColpoVer = 0
' Allineamento dinamico della verifica finale visiva
Dim FineVerifica
FineVerifica = UltimaEstrazioneValida + ColpiGioco
If FineVerifica > EstrattoFinUltimo Then FineVerifica = EstrattoFinUltimo
For EstrVer = (UltimaEstrazioneValida + 1) To FineVerifica
ColpoVer = ColpoVer + 1
RuoteVerifica(1) = R1_Tab(1)
RuoteVerifica(2) = R2_Tab(1)
For j = 1 To 2
RuotaTestSingola(1) = RuoteVerifica(j)
If SerieFreq(EstrVer, EstrVer, NumeriAmbo, RuotaTestSingola, 2) > 0 Then
Scrivi "-> COLPO " & ColpoVer & " (" & DataEstrazione(EstrVer) & "): !!! AMBO IN QUARTINA COLPITO !!! su " & NomeRuota(RuoteVerifica(j)), 1, , vbGreen, vbWhite
TrovatoAmbo = True
End If
Next
Next
If TrovatoAmbo = False Then
Scrivi "Esito nei colpi controllati: Nessun sfaldamento rilevato nelle estrazioni impostate.", 1, , vbCyan, vbBlack
End If
End If
Scrivi "Fine elaborazione.", 1
End Sub
