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

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 01 ottobre 2026
    Bari
    72
    18
    46
    68
    08
    Cagliari
    36
    73
    74
    13
    25
    Firenze
    04
    45
    39
    75
    68
    Genova
    19
    82
    73
    29
    07
    Milano
    35
    53
    23
    20
    05
    Napoli
    65
    07
    29
    41
    34
    Palermo
    09
    51
    48
    31
    58
    Roma
    87
    09
    90
    37
    10
    Torino
    85
    67
    47
    49
    17
    Venezia
    25
    52
    16
    72
    45
    Nazionale
    46
    42
    72
    76
    73
    Estrazione Simbolotto
    26
    04
    23
    41
    30
Indietro
Alto