Script biambo

[ciccioriccio]

Buona sera Cinzia ho visto il tuo messaggio e sai che quando vedo un tuo intervento mi interessa la domanda é sorte e previsione? Grazie molte in anticipo

 

[Cinzia27]

Nulla di tutto ciò, Ciccioriccio. E' solo un reperire più facilmente questo vecchio ma interessante3D.

 

[genios]

Nulla di tutto ciò, Ciccioriccio. E' solo un reperire più facilmente questo vecchio ma interessante3D.

Come è la siuazione attuale dei bi ambi ?

 

[Rookie]

Qualcuno ha qualche info in merito a @i legend ?

 

[genios]

Vi risulta :
BIAMBI CON RITARDO MASSIMO STORICO <= 79
Archivio : 07/01/1871 -> 19/05/2026
Estrazioni: 10,859
Trovate : 5 coppie
Rit.Max = massimo storico | Rit.Att = ritardo attuale
==========================================================
Pos Ambo 1 Ambo 2 Rit.Max Rit.Att
------------------------------------------------------
1. 10-68 41-69 77 2
2. 25-72 41-48 78 23
3. 05-60 47-85 78 3
4. 37-67 63-80 79 16
5. 17-52 48-71 79 3

 

[genios]

vi risulta : su i 34 numeri radicali ?

Pos	Ambo 1	Ambo 2	Rit.Max	Rit.Att
152679	08-10	77-80	222	222
145958	08-10	79-90	199	199
145959	77-80	79-90	199	199
143430	03-88	08-10	194	194
143431	03-88	77-80	194	194
143432	03-88	79-90	194	194
135349	03-88	44-90	182	182
135350	08-10	44-90	182	182
135351	44-90	77-80	182	182
135352	44-90	79-90	182	182

 

[InRicordo]

vi risulta : su i 34 numeri radicali ?

Pos	Ambo 1	Ambo 2	Rit.Max	Rit.Att
152679	08-10	77-80	222	222
145958	08-10	79-90	199	199
145959	77-80	79-90	199	199
143430	03-88	08-10	194	194
143431	03-88	77-80	194	194
143432	03-88	79-90	194	194
135349	03-88	44-90	182	182
135350	08-10	44-90	182	182
135351	44-90	77-80	182	182
135352	44-90	79-90	182	182

 

[InRicordo]

Ho provato a far trasformare la macro in uno Script alla AI. Questo è il risultato, che non funziona, per ora:

Option Explicit

Sub Main

Dim nAmbi, i, s, p
Dim sTitoloAmbi, sRuote, sFiltro
Dim filtroAnni, nRuoteScelte
Dim ruoteSelezionate(12)
Dim ambi(5, 2)
Dim inputOk, pRuote, idxR, x
Dim nEstrTot, idIni, idFin, nEstrAnalizzate
Dim dataLimite, kk, dEstr
Dim aTitoli(34), col

'========================
' INPUT NUMERO AMBI
'========================
nAmbi = Val(InputBox("Quanti ambi vuoi analizzare? (2-5)", "Gruppo Ambi", "2"))
If nAmbi < 2 Or nAmbi > 5 Then
Call Scrivi("Numero ambi non valido. Inserire un valore tra 2 e 5.", True)
Exit Sub
End If

'========================
' INPUT AMBI con validazione
'========================
For i = 1 To nAmbi
inputOk = False
Do While Not inputOk
s = InputBox("Ambo " & i & " (es: 8,77 — numeri tra 1 e 90, diversi tra loro)", "Inserimento ambo " & i)
If s = "" Then Exit Sub
s = Replace(s, ".", ",")
s = Replace(s, " ", "")
p = Split(s, ",")
If UBound(p) <> 1 Then
MsgBox "Formato non valido. Inserisci due numeri separati da virgola."
ElseIf Not IsNumeric(p(0)) Or Not IsNumeric(p(1)) Then
MsgBox "Inserisci solo numeri."
ElseIf CInt(p(0)) < 1 Or CInt(p(0)) > 90 Or CInt(p(1)) < 1 Or CInt(p(1)) > 90 Then
MsgBox "I numeri devono essere compresi tra 1 e 90."
ElseIf CInt(p(0)) = CInt(p(1)) Then
MsgBox "I due numeri dell'ambo devono essere diversi."
Else
ambi(i, 1) = CInt(p(0))
ambi(i, 2) = CInt(p(1))
inputOk = True
End If
Loop
Next i

'========================
' FILTRO PERIODO
'========================
sFiltro = InputBox("Analizza solo gli ultimi N anni (es: 5)." & vbCrLf & _
"Lascia vuoto o 0 per tutto l'archivio.", "Filtro periodo", "0")
filtroAnni = Val(sFiltro)

'========================
' SELEZIONE RUOTE
'========================
sRuote = InputBox("Ruote da analizzare (es: 1,3,5 oppure TUTTE):" & vbCrLf & vbCrLf & _
"1=Bari 2=Cagliari 3=Firenze 4=Genova 5=Milano" & vbCrLf & _
"6=Napoli 7=Palermo 8=Roma 9=Torino 10=Venezia 11=Nazionale", _
"Selezione Ruote", "TUTTE")
If sRuote = "" Then Exit Sub

nRuoteScelte = 0
Dim rr
If UCase(Trim(sRuote)) = "TUTTE" Then
For rr = 1 To 11
ruoteSelezionate(rr) = True
Next rr
nRuoteScelte = 11
Else
pRuote = Split(sRuote, ",")
For x = 0 To UBound(pRuote)
idxR = CInt(Trim(pRuote(x)))
If idxR >= 1 And idxR <= 11 Then
ruoteSelezionate(idxR) = True
nRuoteScelte = nRuoteScelte + 1
End If
Next x
End If

If nRuoteScelte = 0 Then
Call Scrivi("Nessuna ruota valida selezionata.", True)
Exit Sub
End If

'========================
' LIMITI ARCHIVIO
'========================
nEstrTot = EstrazioniArchivio
idFin = nEstrTot
idIni = 1

If filtroAnni > 0 Then
dataLimite = DateAdd("yyyy", -filtroAnni, Now())
For kk = 1 To nEstrTot
dEstr = CDate(DataEstrazione(kk, , , "/"))
If dEstr >= dataLimite Then
idIni = kk
Exit For
End If
Next kk
End If

nEstrAnalizzate = idFin - idIni + 1

'========================
' INTESTAZIONE
'========================
sTitoloAmbi = ""
For i = 1 To nAmbi
If i > 1 Then sTitoloAmbi = sTitoloAmbi & " - "
sTitoloAmbi = sTitoloAmbi & Format2(ambi(i, 1)) & "." & Format2(ambi(i, 2))
Next i

Call Scrivi("STATISTICA GRUPPO AMBI", True, , , vbBlue)
Call Scrivi("Ambi: " & sTitoloAmbi, True)
If filtroAnni > 0 Then
Call Scrivi("Periodo: ultimi " & filtroAnni & " anni (" & nEstrAnalizzate & " estrazioni)", True)
Else
Call Scrivi("Periodo: archivio completo (" & nEstrAnalizzate & " estrazioni)", True)
End If
Call Scrivi()

'========================
' INTESTAZIONI TABELLA
'========================
aTitoli(1) = "Ruota"
aTitoli(2) = "Rit.Att."
aTitoli(3) = "Rit.Max"
aTitoli(4) = "Rit.Medio"
aTitoli(5) = "% su Max"
aTitoli(6) = "Freq"
aTitoli(7) = "IC Norm."
aTitoli(8) = "Ultima Uscita"
aTitoli(9) = "Estratti"

col = 10
For i = 1 To nAmbi
aTitoli(col) = Format2(ambi(i,1)) & "." & Format2(ambi(i,2)) & " Rit.Att."
aTitoli(col + 1) = Format2(ambi(i,1)) & "." & Format2(ambi(i,2)) & " Rit.Max"
aTitoli(col + 2) = Format2(ambi(i,1)) & "." & Format2(ambi(i,2)) & " Freq"
aTitoli(col + 3) = Format2(ambi(i,1)) & "." & Format2(ambi(i,2)) & " Rit.Est."
aTitoli(col + 4) = Format2(ambi(i,1)) & "." & Format2(ambi(i,2)) & " Max.Est."
col = col + 5
Next i

Call InitTabella(aTitoli, vbBlue, , , vbWhite)

'========================
' LOOP RUOTE + TUTTE
'========================
Dim Ru
Dim aEstratti
Dim rit, ritMax, freq, ritMedio, ic, percentMax
Dim dataU, estratti, ritCorr, trovatoPrimo
Dim ritA(5), ritMaxA(5), freqA(5), ritEstA(5), ritEstMaxA(5)
Dim ritCorrA(5), ritCorrEstA(5), trovatoPrimoA(5), trovatoPrimoEstA(5)
Dim id, trovato, rStart, rEnd, rr2, gruppoUscito, a
Dim t1, t2, jj, j
Dim nCols, aValori, aColori, c, nomeRuota

For Ru = 1 To 12

If Ru <= 11 Then
If Not ruoteSelezionate(Ru) Then GoTo SkipRuota
End If

Call Messaggio(IIf(Ru <= 11, NomeRuota(Ru), "Tutte le ruote selezionate"))

rit = 0 : ritMax = 0 : freq = 0
ritMedio = 0 : ic = 0 : percentMax = 0
dataU = "--" : estratti = ""
ritCorr = 0 : trovatoPrimo = False

For a = 1 To nAmbi
ritA(a) = 0 : ritMaxA(a) = 0 : freqA(a) = 0
ritEstA(a) = 0 : ritEstMaxA(a) = 0
ritCorrA(a) = 0 : ritCorrEstA(a) = 0
trovatoPrimoA(a) = False : trovatoPrimoEstA(a) = False
Next a

'========================
' LOOP ESTRAZIONI
'========================
For id = idFin To idIni Step -1

trovato = False

If Ru <= 11 Then
rStart = Ru : rEnd = Ru
Else
rStart = 1 : rEnd = 11
End If

For rr2 = rStart To rEnd

If Ru = 12 Then
If Not ruoteSelezionate(rr2) Then GoTo NextRuota2
End If

Call GetArrayNumeriRuota(id, rr2, aEstratti)
If aEstratti(1) = 0 Then GoTo NextRuota2

gruppoUscito = False
For a = 1 To nAmbi
If AmboUscito(aEstratti, ambi(a, 1), ambi(a, 2)) Then
gruppoUscito = True
Exit For
End If
Next a

If gruppoUscito Then
trovato = True
If Not trovatoPrimo Then
rit = ritCorr
trovatoPrimo = True
dataU = DataEstrazione(id, , , "/")
estratti = ""
For j = 1 To 5
estratti = estratti & Format2(aEstratti(j)) & " "
Next j
If Ru = 12 Then estratti = NomeRuota(rr2) & ": " & estratti
End If
If ritCorr > ritMax Then ritMax = ritCorr
ritCorr = 0
Exit For
End If

NextRuota2:
Next rr2

If trovato Then
freq = freq + 1
Else
ritCorr = ritCorr + 1
End If

'========================
' SINGOLI AMBI (solo ruota singola)
'========================
If Ru <= 11 Then
Call GetArrayNumeriRuota(id, Ru, aEstratti)
For a = 1 To nAmbi
t1 = False : t2 = False
For jj = 1 To 5
If aEstratti(jj) = ambi(a, 1) Then t1 = True
If aEstratti(jj) = ambi(a, 2) Then t2 = True
Next jj

If t1 And t2 Then
freqA(a) = freqA(a) + 1
If Not trovatoPrimoA(a) Then
ritA(a) = ritCorrA(a)
trovatoPrimoA(a) = True
End If
If ritCorrA(a) > ritMaxA(a) Then ritMaxA(a) = ritCorrA(a)
ritCorrA(a) = 0
Else
ritCorrA(a) = ritCorrA(a) + 1
End If

If t1 Or t2 Then
If Not trovatoPrimoEstA(a) Then
ritEstA(a) = ritCorrEstA(a)
trovatoPrimoEstA(a) = True
End If
If ritCorrEstA(a) > ritEstMaxA(a) Then ritEstMaxA(a) = ritCorrEstA(a)
ritCorrEstA(a) = 0
Else
ritCorrEstA(a) = ritCorrEstA(a) + 1
End If

Next a
End If

Call AvanzamentoElab(idIni, idFin, idFin - id)
If ScriptInterrotto Then Exit For

Next id

'========================
' SINGOLI AMBI su "Tutte"
'========================
If Ru = 12 Then
Dim rr3, id2, aE2
Dim rA, rmA, fA, reA, remA
Dim rcA, rceA, tpA, tpeA
Dim ritMinTutte, ritEstMinTutte
Dim u1, u2, jj2

For a = 1 To nAmbi
ritMinTutte = -1 : ritEstMinTutte = -1
ritMaxA(a) = 0 : ritEstMaxA(a) = 0 : freqA(a) = 0

For rr3 = 1 To 11
If Not ruoteSelezionate(rr3) Then GoTo NextRuotaT

rA = 0 : rmA = 0 : fA = 0
reA = 0 : remA = 0
rcA = 0 : rceA = 0
tpA = False : tpeA = False

For id2 = idFin To idIni Step -1
Call GetArrayNumeriRuota(id2, rr3, aE2)
If aE2(1) = 0 Then GoTo NextEstr2

u1 = False : u2 = False
For jj2 = 1 To 5
If aE2(jj2) = ambi(a, 1) Then u1 = True
If aE2(jj2) = ambi(a, 2) Then u2 = True
Next jj2

If u1 And u2 Then
fA = fA + 1
If Not tpA Then
rA = rcA
tpA = True
End If
If rcA > rmA Then rmA = rcA
rcA = 0
Else
rcA = rcA + 1
End If

If u1 Or u2 Then
If Not tpeA Then
reA = rceA
tpeA = True
End If
If rceA > remA Then remA = rceA
rceA = 0
Else
rceA = rceA + 1
End If

NextEstr2:
Next id2

freqA(a) = freqA(a) + fA
If ritMinTutte = -1 Or rA < ritMinTutte Then ritMinTutte = rA
If rmA > ritMaxA(a) Then ritMaxA(a) = rmA
If ritEstMinTutte = -1 Or reA < ritEstMinTutte Then ritEstMinTutte = reA
If remA > ritEstMaxA(a) Then ritEstMaxA(a) = remA

NextRuotaT:
Next rr3

ritA(a) = IIf(ritMinTutte < 0, 0, ritMinTutte)
ritEstA(a) = IIf(ritEstMinTutte < 0, 0, ritEstMinTutte)

Next a
End If

'========================
' CALCOLI
'========================
If freq > 0 Then
ritMedio = Round(nEstrAnalizzate / freq, 1)
If ritMedio > 0 Then ic = Round(rit / ritMedio, 2)
If ritMax > 0 Then percentMax = Round((rit / ritMax) * 100, 1)
End If

'========================
' RIGA TABELLA
'========================
nCols = 9 + nAmbi * 5
ReDim aValori(nCols)
ReDim aColori(nCols)

If Ru <= 11 Then
nomeRuota = NomeRuota(Ru)
Else
nomeRuota = "Tutte"
End If

aValori(1) = nomeRuota
aValori(2) = rit
aValori(3) = ritMax
aValori(4) = ritMedio
aValori(5) = percentMax & "%"
aValori(6) = freq
aValori(7) = ic
aValori(8) = dataU
aValori(9) = Trim(estratti)

col = 10
For i = 1 To nAmbi
aValori(col) = ritA(i)
aValori(col + 1) = ritMaxA(i)
aValori(col + 2) = freqA(i)
aValori(col + 3) = ritEstA(i)
aValori(col + 4) = ritEstMaxA(i)
col = col + 5
Next i

For c = 1 To nCols
aColori(c) = RGB(240, 240, 240)
Next c

If ic >= 2 Then
aColori(7) = vbYellow
ElseIf ic >= 1.5 Then
aColori(7) = RGB(255, 220, 100)
End If

If percentMax >= 80 Then
aColori(5) = RGB(255, 150, 150)
End If

Call AddRigaTabella(aValori, aColori)

SkipRuota:
Next Ru

Call SetTableHeight(7)
Call CreaTabella

Call Scrivi()
Call Scrivi("Legenda IC Norm.: >2 = giallo | >1.5 = arancione", True)
Call Scrivi("Legenda % su Max: >80% = rosso chiaro", True)
Call Scrivi()
Call Scrivi("RAMCOLOTTO - Statistica Gruppo Ambi", True, , , vbBlue)

End Sub

'========================
' VERIFICA AMBO USCITO
'========================
Function AmboUscito(aE, n1, n2)
Dim j, t1, t2
t1 = False : t2 = False
For j = 1 To 5
If aE(j) = n1 Then t1 = True
If aE(j) = n2 Then t2 = True
Next j
AmboUscito = (t1 And t2)
End Function

Lo metto per curiosità. Il tempo era finito e quindi non ho potuto andare avanti.
Non ridete degli errori, deve ancora imparare

 

[genios]

vi risulta :

Pos	Ambo 1	Ambo 2	Rit.Max	Rit.Att
5547	12-13	55-56	159	159
5548	55-56	12-13	159	159
7367	55-56	82-83	194	158
7368	82-83	55-56	194	158
5427	12-13	82-83	158	158
5428	82-83	12-13	158	158
2449	12-13	32-33	132	119
2450	32-33	12-13	132	119
1195	32-33	82-83	122	119
1196	82-83	32-33	122	119
931	32-33	55-56	119	119

 

[Cinzia27]

Su tutte e Nz dalla 8117

3.25;27.57 Sto:44
31.60;76.81 Sto:44
4.16;6.84;Sto:45
20.82;45.56;Sto:45
29.74;33.36;Sto:45

 

[ciccioriccio]

Su tutte e Nz dalla 8117

3.25;27.57 Sto:44
4.16;6.84;Sto:45
20.82;45.56;Sto:45

Rt st complessivo 25
Rt att complessivo 14

Buona domenica Cinzia mi interessa sapere se questi sono ambi da prendere in considerazione per previsione grazie

 

[ciccioriccio]

vi risulta :

Pos	Ambo 1	Ambo 2	Rit.Max	Rit.Att
5547	12-13	55-56	159	159
5548	55-56	12-13	159	159
7367	55-56	82-83	194	158
7368	82-83	55-56	194	158
5427	12-13	82-83	158	158
5428	82-83	12-13	158	158
2449	12-13	32-33	132	119
2450	32-33	12-13	132	119
1195	32-33	82-83	122	119
1196	82-83	32-33	122	119
931	32-33	55-56	119	119

Oppure questi

 

[Cinzia27]

Ciao, Ciccioriccio ti posso rispondere per quelli postati da me, cioè questi ( ne ho trovati altri due).
Per ora non sono in previsione.

Su tutte e Nz dalla 8117

3.25;27.57 Sto:44
31.60;76.81 Sto:44
4.16;6.84;Sto:45
20.82;45.56;Sto:45
29.74;33.36;Sto:45

 

[Acquafresca]

Ciao, Ciccioriccio ti posso rispondere per quelli postati da me, cioè questi ( ne ho trovati altri due).
Per ora non sono in previsione.

Buonasera Cinzia27 ,io son riuscito a fare questo script funzionante assieme all'IA ,per i BiAmbi ,non so se è quello che si adatta alla tua esigenza (mi sembra che si dovrebbe avvicinare ) potrebbe essere sempre migliorabile ,prova a fare dei test e spero che possa essere una buona partenza.
Questo script ha la funzione di scovare le migliori combinazioni storiche di 4 numeri (chiamate "Biambi") su una o più ruote a tua scelta, ordinandole automaticamente dalle più vantaggiose alle meno vantaggiose secondo un preciso calcolo matematico.Invece di analizzare alla cieca gli 8 milioni di combinazioni possibili del Lotto (operazione che farebbe bloccare il computer), lo script applica un pre-filtro intelligente [da_sorgente] basato sulle estrazioni reali per darti il risultato in meno di un secondo.

Codice:
Sub Main()
Dim fine, i, j, c, st, rit, freq, tRuote, k, ic, r, n, maxRit, idRuota
Dim ambi(200, 2)
Dim biambo(4), ruote()
Dim numRitardatari(15)
Dim aTabella(90, 2)

fine = EstrazioneFin

' 1. Selezione delle ruote personali tramite pannello grafico
tRuote = ScegliRuote(ruote)
If tRuote = 0 Then
Scrivi "Operazione annullata. Nessuna ruota selezionata.", 1, 1, vbRed
Exit Sub
End If

' Estraiamo l'indice numerico pulito della prima ruota selezionata per evitare errori di tipo
idRuota = ruote(1)

Scrivi "=== TABELLONE BIAMBI TOP PER RITARDO E CONVENIENZA ===", 1
Scrivi "Analisi sui 15 massimi ritardatari della ruota selezionata", 1
Scrivi "Ruota sotto analisi: " & NomeRuota(idRuota), 1
Scrivi String(100, "-")

' Configurazione della tabella ordinabile
Dim riga(5)
riga(1) = "Combinazione Biambo"
riga(2) = "Ritardo Attuale"
riga(3) = "Ritardo Storico Max"
riga(4) = "Frequenza Totale"
riga(5) = "Indice Convenienza (IC)"
InitTabella riga, vbCyan

' 2. Calcolo dei ritardi usando la funzione universale EstrattoRitardo
For n = 1 To 90
aTabella(n, 1) = n
aTabella(n, 2) = EstrattoRitardo(idRuota, n, , fine)
Next

' Ordinamento manuale dei ritardi decrescenti per isolare i primi 15 numeri
For i = 1 To 89
For j = i + 1 To 90
If aTabella(i, 2) < aTabella(j, 2) Then
Dim tempN, tempR
tempN = aTabella(i, 1) : tempR = aTabella(i, 2)
aTabella(i, 1) = aTabella(j, 1) : aTabella(i, 2) = aTabella(j, 2)
aTabella(j, 1) = tempN : aTabella(j, 2) = tempR
End If
Next
Next

' Trasferiamo i 15 numeri più ritardatari
For i = 1 To 15
numRitardatari(i) = aTabella(i, 1)
Next

' Generiamo gli ambi combinando i 15 ritardatari (105 ambi possibili)
c = 0
For i = 1 To 14
For j = i + 1 To 15
c = c + 1
If numRitardatari(i) < numRitardatari(j) Then
ambi(c, 1) = numRitardatari(i)
ambi(c, 2) = numRitardatari(j)
Else
ambi(c, 1) = numRitardatari(j)
ambi(c, 2) = numRitardatari(i)
End If
Next
Next

' 3. Accoppiamento dei biambi in RAM (Velocissimo)
Dim conta
conta = 0
For i = 1 To c - 1
If ScriptInterrotto Then Exit For
Call AvanzamentoElab(1, c - 1, i)

For j = i + 1 To c
' Evitiamo numeri ripetuti nei due ambi (vogliamo 4 numeri diversi)
If ambi(i, 1) <> ambi(j, 1) And ambi(i, 1) <> ambi(j, 2) And _
ambi(i, 2) <> ambi(j, 1) And ambi(i, 2) <> ambi(j, 2) Then

biambo(1) = ambi(i, 1)
biambo(2) = ambi(i, 2)
biambo(3) = ambi(j, 1)
biambo(4) = ambi(j, 2)

' Calcolo delle statistiche con funzioni Turbo stabili
rit = SerieRitardoTurbo(1, fine, biambo, ruote, 2)

' Filtro per mostrare solo i biambi con ritardo minimo significativo
If rit >= 5 Then
st = SerieStoricoTurbo(1, fine, biambo, ruote, 2)
freq = SerieFreqTurbo(1, fine, biambo, ruote, 2)

If freq > 0 Then
conta = conta + 1
ic = Round(rit / freq, 2) ' Calcolo Indice di Convenienza

riga(1) = "(" & biambo(1) & "-" & biambo(2) & ") + (" & biambo(3) & "-" & biambo(4) & ")"
riga(2) = rit
riga(3) = st
riga(4) = freq
riga(5) = ic

' Inserisce i dati ordinando per Indice Convenienza (Colonna 5, decrescente)
Call AddRigaTabella(riga, , , , , 5)

If conta >= 100 Then Exit For
End If
End If
End If
Next
If conta >= 100 Then Exit For
Next

' 4. Mostra il tabellone ordinabile finale
CreaTabella
Scrivi "Processo concluso con successo. Trovati " & conta & " Biambi ordinati per massima convenienza.", 1
End Sub