RICERCA AMBO ED AMBETTO

[bauman]

Un cordiale saluto a tutto il forum, sto cercando di creare un programma per la ricerca di ambo o ambetto a ruota unica in un periodo variabile di estrazioni, di tempo e numero di colpi, provando a creare uno script, ma ancora non riesco a pieno, chiedo un grande aiuto a tutto il forum, ringraziando in anticipo a tutti coloro che daranno una mano

Option Explicit

Sub Main

' --- CONFIGURAZIONE GIOCATA E ESTRAZIONE ---

Dim Ruota, numeriGiocati, numeriEstratti

Ruota = "Napoli"

numeriGiocati = Array(10, 25)

numeriEstratti = Array(10, 24, 45, 67, 89) ' Esempio di 5 numeri estratti

' --- VARIABILI DI CALCOLO ---

Dim i, j, K

Dim corrispondenze, esattiCount,viciniCount

Dim numG, numE

Dim amboTrovato, ambettoTrovato

Dim Messaggio

esattiCount = 0

ambettoTrovato = False

' 1. VERIFICA AMBO (Contiamo quanti numeri giocati sono presenti nell'estrazione)

For i = 0 & To UBound(numeriGiocati)

    numG = numeriGiocati(i)

    For j = 0 To UBound(numeriEstratti)

        If numG = numeriEstratti(j) Then

            esattiCount = esattiCount + 1

            Exit For

        End If

    Next

Next

If esattiCount >= 2 Then

    amboTrovato = True

End If

' 2. VERIFICA AMBETTO (Funziona se si giocano esattamente 2 numeri)

' Regola: 1 numero esatto + 1 numero dell'estrazione che sia +1 o -1 rispetto all'altro giocato

If UBound(numeriGiocati) = 1 And amboTrovato = False Then

    Dim g1, g2, ev1, ev2, ev3, ev4

    g1 = numeriGiocati(0)

    g2 = numeriGiocati(1)

    ' Calcoliamo i "vicini" gestendo il fuori90 (se applicabile, qui standard +-1)

    ' Nota: Nel lotto l'1 vicino ha il 90 e il 2. Il 90 ha l'89 e l'1.
    

   Function GetVicini(num)

        Dim v(1)

        If num = 1 Then

            v(0) = 90: v(1) = 2

        ElseIf num = 90 Then

            v(0) = 89: v(1) = 1

        Else

            v(0) = num - 1: v(1) = num + 1

        End If

        GetVicini = v

    End Function

    Dim v1, v2

    v1 = GetVicini(g1)

    v2 = GetVicini(g2)

Dim trovatoG1, trovatoG2, trovatoV1, trovatoV2

    trovatoG1 = IsInArray(g1, numeriEstratti)

    trovatoG2 = IsInArray(g2, numeriEstratti)

    trovatoV1 = IsInArray(v1(0), numeriEstratti) Or IsInArray(v1(1), numeriEstratti)

    trovatoV2 = IsInArray(v2(0), numeriEstratti) Or IsInArray(v2(1), numeriEstratti)

    ' Condizione Ambetto: (G1 esatto E un vicino di G2) OPPURE (G2 esatto E un vicino di G1)

   If (trovatoG1 And trovatoV2) Or (trovatoG2 And trovatoV1) Then

        ambettoTrovato = True

    End If

End If

' --- OUTPUT RISULTATO ---

Messaggio = "Ruota analizzata: " & ruota & vbCrLf

Messaggio = Messaggio & "Numeri Giocati: " & Join(numeriGiocati, ", ") & vbCrLf

Messaggio = Messaggio & "Numeri Estratti: " & Join(numeriEstratti, ", ") & vbCrLf & vbCrLf

If amboTrovato Then

    **Messaggio = Messaggio & "ESITO: Complimenti, hai fatto AMBO!"**

ElseIf ambettoTrovato Then

    **Messaggio = Messaggio & "ESITO: Complimenti, hai fatto AMBETTO!"**

Else

    Messaggio = Messaggio & "ESITO: Nessuna vincita (Ambo o Ambetto) su questa ruota."

End If

MsgBox Messaggio, vbInformation, "Verifica Estrazione Lotto"

End Sub

' --- FUNZIONE DI SUPPORTO ---

Function IsInArray(valore, arr)

    Dim x

    IsInArray = False

    For x = 0 To UBound(arr)

        If arr(x) = valore Then

            IsInArray = True

            Exit Function

        End If

    Next

End Function

 

[18k]

ho provato a modificarlo cos'ì, buona giornata

Option Explicit
Sub Main
' --- CONFIGURAZIONE GIOCATA E ESTRAZIONE ---
Dim Ruota,numeriGiocati,numeriEstratti
Ruota = "Napoli"
numeriGiocati = Array(10,25)
numeriEstratti = Array(10,24,45,67,89) ' Esempio di 5 numeri estratti
' --- VARIABILI DI CALCOLO ---
Dim i,j,K
Dim corrispondenze,esattiCount,viciniCount
Dim numG,numE
Dim amboTrovato,ambettoTrovato
Dim Messaggio
esattiCount = 0
ambettoTrovato = False
' 1. VERIFICA AMBO (Contiamo quanti numeri giocati sono presenti nell'estrazione)
For i = 0 To UBound(numeriGiocati)
numG = numeriGiocati(i)
For j = 0 To UBound(numeriEstratti)
If numG = numeriEstratti(j) Then
esattiCount = esattiCount + 1
Exit For
End If
Next
Next
If esattiCount >= 2 Then
amboTrovato = True
End If
' 2. VERIFICA AMBETTO (Funziona se si giocano esattamente 2 numeri)
' Regola: 1 numero esatto + 1 numero dell'estrazione che sia +1 o -1 rispetto all'altro giocato
If UBound(numeriGiocati) = 1 And amboTrovato = False Then
Dim g1,g2,ev1,ev2,ev3,ev4
g1 = numeriGiocati(0)
g2 = numeriGiocati(1)
' Calcoliamo i "vicini" gestendo il fuori90 (se applicabile, qui standard +-1)
' Nota: Nel lotto l'1 vicino ha il 90 e il 2. Il 90 ha l'89 e l'1.
Dim v1,v2
v1 = GetVicini(g1)
v2 = GetVicini(g2)
Dim trovatoG1,trovatoG2,trovatoV1,trovatoV2
trovatoG1 = IsInArray(g1,numeriEstratti)
trovatoG2 = IsInArray(g2,numeriEstratti)
trovatoV1 = IsInArray(v1(0),numeriEstratti) Or IsInArray(v1(1),numeriEstratti)
trovatoV2 = IsInArray(v2(0),numeriEstratti) Or IsInArray(v2(1),numeriEstratti)
' Condizione Ambetto: (G1 esatto E un vicino di G2) OPPURE (G2 esatto E un vicino di G1)
If(trovatoG1 And trovatoV2) Or(trovatoG2 And trovatoV1) Then
ambettoTrovato = True
End If
End If
' --- OUTPUT RISULTATO ---
Scrivi "Ruota analizzata: " & Ruota
Scrivi "Numeri Giocati: " & Join(numeriGiocati,", ")
Scrivi"Numeri Estratti: " & Join(numeriEstratti,", ")
If amboTrovato Then
Scrivi "ESITO: Complimenti, hai fatto AMBO!",1,2,4
ElseIf ambettoTrovato Then
Scrivi "ESITO: Complimenti, hai fatto AMBETTO!",1,2,4
Else
Scrivi "ESITO: Nessuna vincita (Ambo o Ambetto) su questa ruota.",1,2,4
End If
End Sub
' --- FUNZIONE DI SUPPORTO ---
Function IsInArray(valore,arr)
Dim x
IsInArray = False
For x = 0 To UBound(arr)
If arr(x) = valore Then
IsInArray = True
Exit Function
End If
Next
End Function
Function GetVicini(num)
Dim v(1)
If num = 1 Then
v(0) = 90: v(1) = 2
ElseIf num = 90 Then
v(0) = 89: v(1) = 1
Else
v(0) = num - 1: v(1) = num + 1
End If
GetVicini = v
End Function

 

[bauman]

Ciao 18k, grazie per l'intervento, potresti aggiungere la scelta di ruota, periodi di ricerca e colpi da analizzare, grazie

 

[InRicordo]

Questa non vuol essere un'alternativa a quanto già postato, sto semplicemente cercando di utilizzare la AI per fare Script (non sapendone nulla non è semplice) vorrei mi dicessi cosa ne pensi, tenendo conto che non ho capito cosa intendi con "numero di colpi".
Ciao

Option Explicit
Sub Main
Dim aRuote,nRuote,Sin,aTmp,giocati(),nG
Dim Ini,Fin,nUltime,idEstr,i,k,tot
Dim aNum,aB,esito,rit
Dim ultimoAmbo,ultimoAmbetto,ritAmbo,ritAmbetto,maxAmbo,maxAmbetto
Dim cntAmbo,cntAmbetto,sEstratti
Dim sDettaglio,nAmbetti

' --- SCELTA RUOTA (una sola) ---
nRuote = SelRuote(aRuote)
If nRuote <> 1 Or aRuote(1) = TT_ Then
Call Scrivi("Selezionare una sola ruota")
Exit Sub
End If

' --- NUMERI GIOCATI ---
sIn = InputBox("Numeri giocati separati da spazio (da 2 a 10)","Numeri giocati","10 25")
If sIn = "" Then Exit Sub
sIn = Replace(sIn,","," ")
Do While InStr(sIn," ") > 0
sIn = Replace(sIn," "," ")
Loop
aTmp = Split(Trim(sIn)," ")
nG = UBound(aTmp) + 1
If nG < 2 Or nG > 10 Then
Call Scrivi("Servono da 2 a 10 numeri")
Exit Sub
End If
ReDim giocati(nG - 1)
For k = 0 To nG - 1
If Not IsNumeric(aTmp(k)) Then
Call Scrivi("Numero non valido: " & aTmp(k))
Exit Sub
End If
giocati(k) = Int(aTmp(k))
If giocati(k) < 1 Or giocati(k) > 90 Then
Call Scrivi("I numeri devono essere tra 1 e 90")
Exit Sub
End If
Next

' --- ULTIME X ESTRAZIONI (a ritroso dall'ultima) ---
Fin = EstrazioneFin
sIn = InputBox("Quante ultime estrazioni analizzare (a ritroso dall'ultima, la " & Fin & ")","Ultime estrazioni",1000)
If sIn = "" Then Exit Sub
If Not IsNumeric(sIn) Then
Call Scrivi("Numero non valido: " & sIn)
Exit Sub
End If
nUltime = Int(sIn)
If nUltime < 1 Then
Call Scrivi("Il numero di estrazioni deve essere almeno 1")
Exit Sub
End If
Ini = Fin - nUltime + 1
If Ini <= 0 Then Ini = 1
tot = Fin - Ini + 1

' --- INTESTAZIONE ---
Call Scrivi("Ruota: " & StringaRuote(aRuote) & " | Numeri giocati: " & Join(giocati,", "))
Call Scrivi("Ultime " & tot & " estrazioni | dalla " & Ini & " alla " & Fin)
Call Scrivi

' --- SCANSIONE ---
ultimoAmbo = -1
ultimoAmbetto = -1
maxAmbo = 0
maxAmbetto = 0
cntAmbo = 0
cntAmbetto = 0
ReDim aNum(0)

For idEstr = Ini To Fin
i = idEstr - Ini
Call GetArrayNumeriRuota(idEstr,aRuote(1),aNum)
ReDim aB(90)
sEstratti = ""
For k = 1 To UBound(aNum)
aB(aNum(k)) = True
sEstratti = sEstratti & aNum(k) & " "
Next
esito = Verifica(giocati,aB)
' esito: bit 1 = ambo, bit 2 = ambetto (possono esserci entrambi)
If (esito And 1) = 1 Then
rit = i - (ultimoAmbo + 1)
If rit > maxAmbo Then maxAmbo = rit
ultimoAmbo = i
cntAmbo = cntAmbo + 1
Call Scrivi("Colpo " & (i + 1) & " | Estr. " & idEstr & " | AMBO | ritardo " & rit & " | estratti: " & sEstratti)
End If
If (esito And 2) = 2 Then
rit = i - (ultimoAmbetto + 1)
If rit > maxAmbetto Then maxAmbetto = rit
ultimoAmbetto = i
' elenco degli ambetti realizzati in questa estrazione
sDettaglio = DettaglioAmbetti(giocati,aB,nAmbetti)
' le uscite contano ogni singolo ambetto realizzato
cntAmbetto = cntAmbetto + nAmbetti
Call Scrivi("Colpo " & (i + 1) & " | Estr. " & idEstr & " | AMBETTO | ritardo " & rit & " | estratti: " & sEstratti & "| ambetti " & nAmbetti & ": " & sDettaglio)
End If
Call AvanzamentoElab(Ini,Fin,idEstr)
If ScriptInterrotto Then Exit For
Next

' --- RIEPILOGO ---
ritAmbo = tot - 1 - ultimoAmbo
If ritAmbo > maxAmbo Then maxAmbo = ritAmbo
ritAmbetto = tot - 1 - ultimoAmbetto
If ritAmbetto > maxAmbetto Then maxAmbetto = ritAmbetto

Call Scrivi
Call Scrivi("AMBO: uscite " & cntAmbo & " | ritardo attuale " & ritAmbo & " | ritardo massimo " & maxAmbo)
Call Scrivi("AMBETTO: uscite " & cntAmbetto & " | ritardo attuale " & ritAmbetto & " | ritardo massimo " & maxAmbetto)
End Sub

' --- VERIFICA: restituisce 0 = niente, 1 = ambo, 2 = ambetto, 3 = entrambi ---
' aB = True se il numero n e' stato estratto
Function Verifica(giocati,aB)
Dim x,y,a,b,esatti
Dim bAmbetto
Verifica = 0

' AMBO: almeno 2 numeri giocati estratti
esatti = 0
For x = 0 To UBound(giocati)
If aB(giocati(x)) Then esatti = esatti + 1
Next
If esatti >= 2 Then Verifica = 1

' AMBETTO: per ogni coppia di numeri giocati (a,b)
' vince se esce a + un vicino di b (diverso da a), oppure b + un vicino di a (diverso da b)
bAmbetto = False
For x = 0 To UBound(giocati) - 1
For y = x + 1 To UBound(giocati)
a = giocati(x)
b = giocati
If aB(a) Then
If VicinoEstratto(b,a,aB) Then bAmbetto = True
End If
If aB(b) Then
If VicinoEstratto(a,b,aB) Then bAmbetto = True
End If
If bAmbetto Then Exit For
Next
If bAmbetto Then Exit For
Next
If bAmbetto Then Verifica = Verifica + 2
End Function

' Elenca tutti gli ambetti realizzati in un'estrazione, nel formato
' "numero giocato estratto + vicino estratto (vicino di numero giocato)"
' nTrovati restituisce quanti sono
Function DettaglioAmbetti(giocati,aB,nTrovati)
Dim x,y,a,b,v,j,s
s = ""
nTrovati = 0
For x = 0 To UBound(giocati) - 1
For y = x + 1 To UBound(giocati)
a = giocati(x)
b = giocati
' a estratto + vicino di b estratto
If aB(a) Then
v = GetVicini(b)
For j = 0 To 1
If v(j) <> a And aB(v(j)) Then
If s <> "" Then s = s & "; "
s = s & a & "+" & v(j) & " (" & v(j) & " vicino di " & b & ")"
nTrovati = nTrovati + 1
End If
Next
End If
' b estratto + vicino di a estratto
If aB(b) Then
v = GetVicini(a)
For j = 0 To 1
If v(j) <> b And aB(v(j)) Then
If s <> "" Then s = s & "; "
s = s & b & "+" & v(j) & " (" & v(j) & " vicino di " & a & ")"
nTrovati = nTrovati + 1
End If
Next
End If
Next
Next
DettaglioAmbetti = s
End Function

' True se tra i vicini di n (precedente/successivo, 90 e 1 consecutivi)
' c'e' un numero estratto diverso da "escluso"
Function VicinoEstratto(n,escluso,aB)
Dim v
v = GetVicini
VicinoEstratto = False
If v(0) <> escluso Then
If aB(v(0)) Then VicinoEstratto = True
End If
If v(1) <> escluso Then
If aB(v(1)) Then VicinoEstratto = True
End If
End Function

Function GetVicini(num)
Dim v(1)
If num = 1 Then
v(0) = 90: v(1) = 2
ElseIf num = 90 Then
v(0) = 89: v(1) = 1
Else
v(0) = num - 1: v(1) = num + 1
End If
GetVicini = v
End Function

Function SelRuote(aRuote)
Dim t,k,bTutte
bTutte = False
t = ScegliRuote(aRuote)
For k = 1 To t
If aRuote(k) = TT_ Then
bTutte = True
Exit For
End If
Next
If bTutte Then
ReDim aRuote(10)
For k = 1 To 10
aRuote(k) = k
Next
SelRuote = 10
Else
SelRuote = t
End If
End Function

 

[18k]

ti posto alcuni suggerimenti per il momento
puoi scegliere la ruota


ReDim Ruota(12)
ScegliRuote(Ruota)

puoi scegliere i numeri giocati

ScegliNumeri(numeriGiocati)
nqt = UBound(numeriGiocati)

puoi inserire il periodo dal.... al

periododal = InputBox("Verifica dal ",,10800)
periodoal = EstrazioneFin
' --- OUTPUT RISULTATO ---
Scrivi "Ruota analizzata: " & NomeRuota(Ruota(1)),1,2,3
Scrivi "Numeri Giocati: " & Join(numeriGiocati,", "),1

puoi fare scrivere una specie di intestazione allo script
puoi calcolare subito gli eventuali numeri che serviranno per controllare gli ambetti che ti serviranno poi per la verifica di eventuale uscita
v1 = numeriGiocati(1) - 1
v2 = numeriGiocati(1) + 1
v3 = numeriGiocati(2) - 1
v4 = numeriGiocati(2) + 1
Scrivi "Numeri controllo ambetti " & Format2(v1) & " " & Format2(v2) & " " & Format2(v3) & " " & Format2(v4),1,2,2
Scrivi "Verifica nel Periodo : " & periododal + 1 & " " & DataEstrazione(periododal + 1) & " " & periodoal & " " & DataEstrazione(periodoal)
Scrivi

 

[18k]

x inricordo

ho provato lo script che hai postato, è molto lungo, quasi mi viene il dubbio che sia in loop.

mi sembra strano io ho impostato dalla 3950 ad oggi 10949, ma lo script elabora le ultime 1000 estrazioni

sIn = InputBox("Quante ultime estrazioni analizzare (a ritroso dall'ultima, la " & Fin & ")","Ultime estrazioni",1000)


forse come limite di n.di colpi intende di far eseguire il verificaesitoturbo con spaziometria, qui si possono impostare il n.colpi

ma che poi sappia io, la verifica dell'ambetto il verificaesitoturbo non la effettua,, estratti e ambi o superiori si. ma ambetto no, è da far eseguire in modo diverso la verifica.


in modo molto artigianale
Prova ambo. 10 74 su napoli
Option Explicit
Sub Main
' --- CONFIGURAZIONE GIOCATA E ESTRAZIONE ---
Dim numeriGiocati(2),numeriEstratti(5)
' --- VARIABILI DI CALCOLO ---
Dim i,j,K,nqt,trovati
Dim corrispondenze,esattiCount,viciniCount
Dim numG,numE,nu,periododal,periodoal,retesito,retestratti,retidestr
Dim amboTrovato,ambettoTrovato,p,w,dal,v1,v2,v3,v4,esatto
ReDim Ruota(12)
ScegliRuote(Ruota)
ScegliNumeri(numeriGiocati)
nqt = UBound(numeriGiocati)
''verifica esiti
periododal = InputBox("Verifica dal ",,10800)
periodoal = EstrazioneFin
' --- OUTPUT RISULTATO ---
Scrivi "Ruota analizzata: " & NomeRuota(Ruota(1)),1,2,3
Scrivi "Numeri Giocati: " & Join(numeriGiocati,", "),1
v1 = numeriGiocati(1) - 1
v2 = numeriGiocati(1) + 1
v3 = numeriGiocati(2) - 1
v4 = numeriGiocati(2) + 1
Scrivi "Numeri controllo ambetti " & Format2(v1) & " " & Format2(v2) & " " & Format2(v3) & " " & Format2(v4),1,2,2
Scrivi "Verifica nel Periodo : " & periododal + 1 & " " & DataEstrazione(periododal + 1) & " " & periodoal & " " & DataEstrazione(periodoal)
Scrivi
For dal = periododal + 1 To periodoal
'''carica 5 numeri dell'estrazione
For p = 1 To 5
numeriEstratti(p) = Estratto(dal,Ruota(1),p)
Next
Scrivi dal & " " & StringaNumeri(numeriEstratti,".")
'''controlla quanti numeri giocati ci sono in quelli estratti
esattiCount = 0
trovati = ""
esatto = ""
For p = 1 To 5
For w = 1 To nqt
If numeriGiocati(w) = numeriEstratti(p) Then
esattiCount = esattiCount + 1
trovati = trovati & numeriEstratti(p) & " "
esatto = numeriGiocati(w)
End If
Next
Next
If esattiCount = 1 Then
Scrivi dal & " ----> Estratti Trovati " & Format2(trovati),1,2,4
End If
If esattiCount = 2 Then
Scrivi dal & " Ambo : " & numeriGiocati(1) & "." & numeriGiocati(2),1,2,3
End If
' 2. VERIFICA AMBETTO (Funziona se si giocano esattamente 2 numeri)
' Regola: 1 numero esatto + 1 numero dell'estrazione che sia +1 o -1 rispetto all'altro giocato
If esattiCount = 1 Then
For p = 1 To 5
If esatto = numeriGiocati(1) Then
If numeriEstratti(p) = v3 Or numeriEstratti(p) = v4 Then
Scrivi dal & " Ambetto : " & Format2(trovati) & " " & Format2(numeriEstratti(p)),1,2,2
End If
End If
If esatto = numeriGiocati(2) Then
If numeriEstratti(p) = v1 Or numeriEstratti(p) = v2 Then
Scrivi dal & " Ambetto : " & Format2(trovati) & " " & Format2(numeriEstratti(p)),1,2,2
End If
End If
Next
End If
Next
Scrivi "Tempo Elab. " & TempoTrascorso,1
End Sub


si può fare meglio naturalmente.