Novità

BARI/CAGLIARI

Spero di fare cosa gradita ,condivido il mio script dove in più occasioni ci azzecca : se poi qualcuno più esperto riesce a migliorarlo è il benvenuto .
codice:

Sub Main

Dim Es,Clp,Nu(2),Ruote(2),Poste(3)
Dim Inizio,Fine,Casi,Capogioco
Dim rCalcolo,pCalcolo
Dim FreqAbbinamenti(90) ' Array per contare le frequenze degli 89 abbinamenti
Dim n, x, y, idGiocata

' ==================================================================
' PANNELLO DI CONTROLLO: SCEGLI SOLO DOVE PRENDERE IL Capogioco
' ==================================================================
rCalcolo = FI_ ' Ruota di calcolo (es. FIRENZE)
pCalcolo = 4 ' Posizione dell'estratto (es. 4° Estratto)
' ==================================================================

' --- IMPOSTAZIONI DI GIOCO STANDARD ---
Clp = 18
Ruote(1) = BA_
Ruote(2) = CA_
Poste(1) = 1 ' 1 Euro su ESTRATTO
Poste(2) = 1 ' 1 Euro su AMBO SECCO

Inizio = EstrazioneFin -250
Fine = EstrazioneFin
Casi = 0

' Azzera l'array delle frequenze
For n = 1 To 90 : FreqAbbinamenti(n) = 0 : Next

'--- FASE 1: ANALISI STORICA AUTOMATICA (Trova i Migliori partner per l'Ambo) ---
For Es = Inizio To Fine
If IsUltimaDelMese(Es) Then
Capogioco = Estratto(Es, rCalcolo, pCalcolo)

' Scansiona i successivi 18 colpi reali su BA e CA per vedere chi è uscito insieme al capogioco
For n = 1 To 90
If n <> Capogioco Then
Nu(1) = Capogioco : Nu(2) = n
' Accumula le presenze reali di ambo nei 18 colpi successivi
FreqAbbinamenti(n) = FreqAbbinamenti(n) + SerieFreqTurbo(Es + 1, Es + Clp, Nu, Ruote, 2)
End If
Next
End If
Next

' --- FASE 2: ESTRAZIONE DEI 3 NUMERI TOP ---
Dim Migliori(3), MaxFreq, Scelto
For x = 1 To 3
MaxFreq = - 1
Scelto = 0
For y = 1 To 90
If FreqAbbinamenti(y) > MaxFreq Then
' Controlla se il numero è già stato preso nei passaggi precedenti
Dim GiaPreso : GiaPreso = False
Dim z
For z = 1 To x - 1
If Migliori(z) = y Then GiaPreso = True
Next

If Not GiaPreso Then
MaxFreq = FreqAbbinamenti(y)
Scelto = y
End If
End If
Next
Migliori(x) = Scelto
Next

' --- STAMPA DEL VERDETTO DEI NUMERI TROVATI ---
Scrivi "==================================================================",1
Scrivi " ALGORITMO AUTO-OTTIMIZZANTE DI ACCOPPIAMENTO STATISTICO ",1
Scrivi " ANALISI DA: " & NomeRuota(rCalcolo) & " (" & pCalcolo & "° ESTRATTO)",1
Scrivi "==================================================================",1
Scrivi "Il computer ha analizzato l'archivio e ha estratto i 3 migliori partner:",1
Scrivi "1° Miglior abbinamento rilevato: Numero [ " & Migliori(1) & " ]"
Scrivi "2° Miglior abbinamento rilevato: Numero [ " & Migliori(2) & " ]"
Scrivi "3° Miglior abbinamento rilevato: Numero [ " & Migliori(3) & " ]"
Scrivi "==================================================================",1
Scrivi

' --- FASE 3: SIMULAZIONE REALE CON I NUOVI NUMERI TROVATI DAL PC ---
idGiocata = 0
For Es = Inizio To Fine
If IsUltimaDelMese(Es) Then
Casi = Casi + 1
Capogioco = Estratto(Es, rCalcolo, pCalcolo)

Scrivi String(100,"-")
Scrivi "Caso n° " & Casi & " - Data: " & DataEstrazione(Es) & " [Estr. n° " & Es & "]"
Scrivi "Capogioco generato: " & Capogioco
Scrivi "Ambi calcolati dal PC: " & Capogioco & "-" & Migliori(1) & " / " & Capogioco & "-" & Migliori(2) & " / " & Capogioco & "-" & Migliori(3)
Scrivi String(100,"-")

idGiocata = idGiocata + 1
Nu(1) = Capogioco : Nu(2) = Migliori(1)
ImpostaGiocata idGiocata, Nu, Ruote, Poste, Clp, 2

idGiocata = idGiocata + 1
Nu(1) = Capogioco : Nu(2) = Migliori(2)
ImpostaGiocata idGiocata, Nu, Ruote, Poste, Clp, 2

idGiocata = idGiocata + 1
Nu(1) = Capogioco : Nu(2) = Migliori(3)
ImpostaGiocata idGiocata, Nu, Ruote, Poste, Clp, 2

Gioca Es, True
End If
Next
ScriviResoconto
End Sub

Function IsUltimaDelMese(idEs)
Dim mCorr, mSucc
mCorr = Mese(idEs)
mSucc = Mese(idEs + 1)
If mCorr <> mSucc Then IsUltimaDelMese = True Else IsUltimaDelMese = False
End Function
--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
allego anche alcuni risultati e pronostico per tutto il mese di Ottobre
 

Allegati

  • Screenshot 2026-09-29 231734.png
    Screenshot 2026-09-29 231734.png
    564,3 KB · Visite: 10
  • Screenshot 2026-09-29 231807.png
    Screenshot 2026-09-29 231807.png
    559,8 KB · Visite: 10
Spero di fare cosa gradita ,condivido il mio script dove in più occasioni ci azzecca : se poi qualcuno più esperto riesce a migliorarlo è il benvenuto .
codice:

Sub Main

Dim Es,Clp,Nu(2),Ruote(2),Poste(3)
Dim Inizio,Fine,Casi,Capogioco
Dim rCalcolo,pCalcolo
Dim FreqAbbinamenti(90) ' Array per contare le frequenze degli 89 abbinamenti
Dim n, x, y, idGiocata

' ==================================================================
' PANNELLO DI CONTROLLO: SCEGLI SOLO DOVE PRENDERE IL Capogioco
' ==================================================================
rCalcolo = FI_ ' Ruota di calcolo (es. FIRENZE)
pCalcolo = 4 ' Posizione dell'estratto (es. 4° Estratto)
' ==================================================================

' --- IMPOSTAZIONI DI GIOCO STANDARD ---
Clp = 18
Ruote(1) = BA_
Ruote(2) = CA_
Poste(1) = 1 ' 1 Euro su ESTRATTO
Poste(2) = 1 ' 1 Euro su AMBO SECCO

Inizio = EstrazioneFin -250
Fine = EstrazioneFin
Casi = 0

' Azzera l'array delle frequenze
For n = 1 To 90 : FreqAbbinamenti(n) = 0 : Next

'--- FASE 1: ANALISI STORICA AUTOMATICA (Trova i Migliori partner per l'Ambo) ---
For Es = Inizio To Fine
If IsUltimaDelMese(Es) Then
Capogioco = Estratto(Es, rCalcolo, pCalcolo)

' Scansiona i successivi 18 colpi reali su BA e CA per vedere chi è uscito insieme al capogioco
For n = 1 To 90
If n <> Capogioco Then
Nu(1) = Capogioco : Nu(2) = n
' Accumula le presenze reali di ambo nei 18 colpi successivi
FreqAbbinamenti(n) = FreqAbbinamenti(n) + SerieFreqTurbo(Es + 1, Es + Clp, Nu, Ruote, 2)
End If
Next
End If
Next

' --- FASE 2: ESTRAZIONE DEI 3 NUMERI TOP ---
Dim Migliori(3), MaxFreq, Scelto
For x = 1 To 3
MaxFreq = - 1
Scelto = 0
For y = 1 To 90
If FreqAbbinamenti(y) > MaxFreq Then
' Controlla se il numero è già stato preso nei passaggi precedenti
Dim GiaPreso : GiaPreso = False
Dim z
For z = 1 To x - 1
If Migliori(z) = y Then GiaPreso = True
Next

If Not GiaPreso Then
MaxFreq = FreqAbbinamenti(y)
Scelto = y
End If
End If
Next
Migliori(x) = Scelto
Next

' --- STAMPA DEL VERDETTO DEI NUMERI TROVATI ---
Scrivi "==================================================================",1
Scrivi " ALGORITMO AUTO-OTTIMIZZANTE DI ACCOPPIAMENTO STATISTICO ",1
Scrivi " ANALISI DA: " & NomeRuota(rCalcolo) & " (" & pCalcolo & "° ESTRATTO)",1
Scrivi "==================================================================",1
Scrivi "Il computer ha analizzato l'archivio e ha estratto i 3 migliori partner:",1
Scrivi "1° Miglior abbinamento rilevato: Numero [ " & Migliori(1) & " ]"
Scrivi "2° Miglior abbinamento rilevato: Numero [ " & Migliori(2) & " ]"
Scrivi "3° Miglior abbinamento rilevato: Numero [ " & Migliori(3) & " ]"
Scrivi "==================================================================",1
Scrivi

' --- FASE 3: SIMULAZIONE REALE CON I NUOVI NUMERI TROVATI DAL PC ---
idGiocata = 0
For Es = Inizio To Fine
If IsUltimaDelMese(Es) Then
Casi = Casi + 1
Capogioco = Estratto(Es, rCalcolo, pCalcolo)

Scrivi String(100,"-")
Scrivi "Caso n° " & Casi & " - Data: " & DataEstrazione(Es) & " [Estr. n° " & Es & "]"
Scrivi "Capogioco generato: " & Capogioco
Scrivi "Ambi calcolati dal PC: " & Capogioco & "-" & Migliori(1) & " / " & Capogioco & "-" & Migliori(2) & " / " & Capogioco & "-" & Migliori(3)
Scrivi String(100,"-")

idGiocata = idGiocata + 1
Nu(1) = Capogioco : Nu(2) = Migliori(1)
ImpostaGiocata idGiocata, Nu, Ruote, Poste, Clp, 2

idGiocata = idGiocata + 1
Nu(1) = Capogioco : Nu(2) = Migliori(2)
ImpostaGiocata idGiocata, Nu, Ruote, Poste, Clp, 2

idGiocata = idGiocata + 1
Nu(1) = Capogioco : Nu(2) = Migliori(3)
ImpostaGiocata idGiocata, Nu, Ruote, Poste, Clp, 2

Gioca Es, True
End If
Next
ScriviResoconto
End Sub

Function IsUltimaDelMese(idEs)
Dim mCorr, mSucc
mCorr = Mese(idEs)
mSucc = Mese(idEs + 1)
If mCorr <> mSucc Then IsUltimaDelMese = True Else IsUltimaDelMese = False
End Function
--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
allego anche alcuni risultati e pronostico per tutto il mese di Ottobre
mi da errore non riesco a farlo girare
controlla se è tutto giusto
grazie intanto
 
mi da errore non riesco a farlo girare
controlla se è tutto giusto
grazie intanto
Ciao Geronimo, penso di aver capito il perchè ,lo script è giusto ,solo che quando lo copi in spaziometria all'inizio hai in più le voci:
Option Explicit
e (
due) Sub Main ( le quali le vai ad eliminare entrambi lasciando solo un Sub Main quello del codice ) e alla fine del codice dopo End Function appare
End Sub (anche questo và eliminato ) poi salvalo e lancialo vedrai che funziona. Fammi sapere se è andato a buon fine
 
Ciao Geronimo, penso di aver capito il perchè ,lo script è giusto ,solo che quando lo copi in spaziometria all'inizio hai in più le voci:
Option Explicit
e (
due) Sub Main ( le quali le vai ad eliminare entrambi lasciando solo un Sub Main quello del codice ) e alla fine del codice dopo End Function appare
End Sub (anche questo và eliminato ) poi salvalo e lancialo vedrai che funziona. Fammi sapere se è andato a buon fine
il primo sub main non lo copio mai .... lasciavo però end sub finale ... funziona grazie
 
Per tutto il mese di Ottobre fino all'uscita almeno di un ambo
Estrazione generatrice del pronostico 10935 [157 - 29/09/2026]
Numeri in gioco : 14.18 su BA CA per Estratto, Ambo
( analisi a 9 colpi )
Numeri in gioco : 14.81 su BA CA per Estratto, Ambo ( analisi a 9 colpi )
Numeri in gioco : 14.90 su BA CA per Estratto, Ambo ( analisi a 9 e 18 colpi )
Numeri in gioco : 14.50 su BA CA per Estratto, Ambo ( analisi a 18 colpi )
Numeri in gioco : 14.63 su BA CA per Estratto, Ambo ( analisi a 18 colpi )

a piacere la lunghetta 14 18 50 63 81 90
 
Ultima modifica:
Stasera il 23...ce l'avevo ba/Ca/na...a Bari niente sto strrr😂
Celyne 23/24 sono 3 estrazioni che lo gioco secco.. speriamo che gira e rigira arrivi a Bari!
 

Ultima estrazione Lotto

  • Estrazione del lotto
    venerdì 02 ottobre 2026
    Bari
    61
    45
    73
    41
    66
    Cagliari
    23
    79
    47
    36
    34
    Firenze
    48
    58
    43
    02
    44
    Genova
    83
    87
    18
    12
    22
    Milano
    59
    31
    22
    41
    46
    Napoli
    70
    23
    27
    26
    05
    Palermo
    70
    48
    32
    86
    47
    Roma
    19
    25
    56
    38
    26
    Torino
    23
    33
    30
    57
    62
    Venezia
    52
    32
    46
    19
    51
    Nazionale
    39
    63
    14
    25
    85
    Estrazione Simbolotto
    43
    38
    02
    26
    13
Indietro
Alto