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: 13
  • Screenshot 2026-09-29 231807.png
    Screenshot 2026-09-29 231807.png
    559,8 KB · Visite: 13
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:

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 10 ottobre 2026
    Bari
    16
    38
    53
    21
    55
    Cagliari
    21
    66
    30
    55
    62
    Firenze
    30
    75
    23
    10
    68
    Genova
    68
    31
    16
    64
    63
    Milano
    20
    05
    11
    17
    64
    Napoli
    30
    74
    82
    78
    77
    Palermo
    17
    15
    50
    80
    44
    Roma
    05
    32
    59
    39
    66
    Torino
    31
    59
    56
    29
    20
    Venezia
    11
    66
    07
    61
    88
    Nazionale
    18
    52
    01
    28
    13
    Estrazione Simbolotto
    34
    33
    05
    22
    14

Ultimi Messaggi

Indietro
Alto