Novità

scripi ambo in quartina su 2 ruote

M

mistrall

Member
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
 
per funzionare, funziona, però mi sembra che qualcosa non va, presenta quasi sempre bari ed una ruota secondaria, eccetto sempre 1 variante Cagliari - Milano.

non so, bisognerebbe che qualcuno lo guardi con l'intento di fare un reale controllo. anche cambiando indice mensile

Screenshot 2026-08-17 074703.png
 
buongiorno, si ieri sera infatti l'ho fatto correggere, ora il calcolo lo fa fare su tutte le ruote, questa sera posto lo script
 
salve a tutti, rimetto script aggiornato

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

' Dimensionamento espanso a 450.000 per contenere TUTTE le combinazioni reali
Dim R1_Tab(450000),P1A_Tab(450000),P1B_Tab(450000)
Dim R2_Tab(450000),P2A_Tab(450000),P2B_Tab(450000)
Dim Vincenti_Tab(450000),Perc_Tab(450000)

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 TOTALE RUOTE - SCREENING REALE ===", 1, , vbBlue, vbWhite
Scrivi "Calcolo: Screening automatico con verifica esiti su tutte le combinazioni per " & ColpiGioco & " COLPI SUCC.", 1, , vbBlack, vbYellow
Scrivi "Formula: Elezione del Minore meno Maggiore e fuori 90 inverso con Vertibili", 1
Scrivi "--------------------------------------------------------------------------------"

' Caricamento integrale di tutte le strutture geometriche senza blocchi a 950
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
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
Next
Next
Next
Next
Next
Next

TotalePrevisioni = 0
UltimaEstrazioneValida = 0

' --- FASE 1: Calcolo Statistico filtrato sulle coppie di ruote ---
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)

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 TRA TUTTE LE 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

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
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    lunedì 17 agosto 2026
    Bari
    20
    17
    30
    42
    19
    Cagliari
    44
    79
    25
    21
    66
    Firenze
    32
    05
    03
    31
    42
    Genova
    13
    78
    64
    06
    86
    Milano
    22
    88
    80
    59
    23
    Napoli
    63
    20
    35
    10
    61
    Palermo
    66
    12
    49
    53
    07
    Roma
    09
    39
    43
    81
    68
    Torino
    05
    41
    22
    79
    16
    Venezia
    42
    21
    59
    82
    83
    Nazionale
    80
    12
    77
    10
    44
    Estrazione Simbolotto
    Nazionale
    07
    44
    34
    02
    41
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto