buon pomeriggio vincenzo63, ecco il codice con la variante richiesta:
Sub Main
Dim es, r, p, i, a, b
Dim nTrovati, sNumeri, sEsito
Dim k, idNum, dec, cad
Dim sElenco, cTotEventi, rVera, nEstratto
Dim aTrovatiTemp(5)
Dim nTmpCount, jj
Dim tmpN, tmpF
' --- PARAMETRI DI CONFIGURAZIONE TRAMITE INPUTBOX ---
Dim sDecineScelte, sCadenzeScelte
' Richiesta interattiva delle decine
sDecineScelte = InputBox("Inserisci le decine da esaminare separate da virgola (es. 3, 6, 8):" & vbCrLf & "(0 per 1-9, 1 per 10-19, 2 per 20-29, 3 per 30-39, ecc.)", "Configurazione Decine", "3, 6, 8")
If VarType(sDecineScelte) = vbBoolean And sDecineScelte = False Then Exit Sub ' Gestione tasto Annulla
' Richiesta interattiva delle cadenze
sCadenzeScelte = InputBox("Inserisci le cadenze da esaminare separate da virgola (es. 3, 6, 8):", "Configurazione Cadenze", "3, 6, 8")
If VarType(sCadenzeScelte) = vbBoolean And sCadenzeScelte = False Then Exit Sub ' Gestione tasto Annulla
' ---------------------------------------------------
' Array di base (dichiarati dinamici per consentire il ridimensionamento pulito)
Dim aNumeri()
Dim aContaQ(11), aContaC(11)
Dim aFreqNum(90)
' --- Variabili per il metodo previsivo ---
Dim aUltimaUscita(11, 90)
Dim aRitardo(11, 90)
Dim nRuotaIdx, nNumIdx
Dim aTmpNum(), aTmpRit()
Dim tmpS, tmpNN
Dim sRiga, nLimit
' 1. Generazione automatica della massa dei numeri in base alle scelte
k = 0
ReDim aNumeri(90)
For idNum = 1 To 90
dec = CInt(idNum \ 10)
cad = idNum Mod 10
If VerificaFiltro(dec, cad, sDecineScelte, sCadenzeScelte) Then
k = k + 1
aNumeri(k) = idNum
End If
Next
' Ridimensiona gli array alla dimensione reale k
ReDim Preserve aNumeri(k)
ReDim aTmpNum(k)
ReDim aTmpRit(k)
If k = 0 Then
MsgBox "Attenzione: nessun numero soddisfa i criteri inseriti. Controlla le configurazioni.", vbCritical
Exit Sub
End If
' --- Inizializzazioni rapide ---
For i = 1 To 11
aContaQ(i) = 0
aContaC(i) = 0
Next
For i = 1 To 90
aFreqNum(i) = 0
Next
For i = 1 To 11
For jj = 1 To 90
aUltimaUscita(i, jj) = 0
Next
Next
' --- VISUALIZZAZIONE MASSA DEI NUMERI A MONTE ---
ColoreTesto 2
Scrivi "================================================================================"
Scrivi " MASSA NUMERICA DI ANALISI (Totale Numeri: " & k & ")"
Scrivi " Decine esaminate: [" & sDecineScelte & "] | Cadenze esaminate: [" & sCadenzeScelte & "]"
Scrivi "================================================================================"
sElenco = ""
For i = 1 To k
sElenco = sElenco & Format2(aNumeri(i)) & " "
If i Mod 24 = 0 Then
Scrivi sElenco
sElenco = ""
End If
Next
If sElenco <> "" Then Scrivi sElenco
Scrivi "--------------------------------------------------------------------------------"
ColoreTesto 1
Scrivi " STORICO EVENTI DI QUATERNA E CINQUINA"
Scrivi "--------------------------------------------------------------------------------"
Scrivi " N. | Data | Ruota | Esito | Numeri Sortiti"
Scrivi "--------------------------------------------------------------------------------"
cTotEventi = 0
' 2. Scansione dell'archivio storico
For es = 3549 To EstrazioniArchivio
If ScriptInterrotto Then
ColoreTesto 2
Scrivi "--------------------------------------------------------------------------------"
Scrivi "--> Elaborazione interrotta dall'utente.", True
Exit Sub
End If
For r = 1 To 12
If r <> 11 Then
rVera = r
If r = 12 Then rVera = 11
nTrovati = 0
sNumeri = ""
nTmpCount = 0
For p = 1 To 5
nEstratto = Estratto(es, rVera, p)
If Sme_InVettore(nEstratto, aNumeri) Then
nTrovati = nTrovati + 1
sNumeri = sNumeri & Format2(nEstratto) & " "
nTmpCount = nTmpCount + 1
aTrovatiTemp(nTmpCount) = nEstratto
End If
Next
If nTrovati >= 4 Then
cTotEventi = cTotEventi + 1
If nTrovati = 4 Then
sEsito = "QUATERNA"
aContaQ(rVera) = aContaQ(rVera) + 1
Else
sEsito = "CINQUINA"
aContaC(rVera) = aContaC(rVera) + 1
End If
For jj = 1 To nTmpCount
aFreqNum(aTrovatiTemp(jj)) = aFreqNum(aTrovatiTemp(jj)) + 1
aUltimaUscita(rVera, aTrovatiTemp(jj)) = es
Next
Scrivi FormatSpace(cTotEventi, 4, True) & " | " & _
DataEstrazione(es) & " | " & _
FormatSpace(NomeRuota(rVera), 10, False) & " | " & _
FormatSpace(sEsito, 8, False) & " | " & _
sNumeri
End If
End If
Next
Next
' --- RIEPILOGO PER RUOTA ---
ColoreTesto 2
Scrivi "--------------------------------------------------------------------------------"
Scrivi " RIEPILOGO FREQUENZE PER RUOTA (Quaterne / Cinquine)"
Scrivi "--------------------------------------------------------------------------------"
For i = 1 To 11
Scrivi FormatSpace(NomeRuota(i), 10, False) & " | Quaterne: " & aContaQ(i) & _
" | Cinquine: " & aContaC(i) & " | Totale: " & (aContaQ(i) + aContaC(i))
Next
' --- RIEPILOGO FREQUENZA SINGOLI NUMERI ---
Scrivi "--------------------------------------------------------------------------------"
Scrivi " FREQUENZA DEI NUMERI DELLA MASSA ALL'INTERNO DEGLI EVENTI Q/C (ordinati)"
Scrivi "--------------------------------------------------------------------------------"
For i = 1 To k
aTmpNum(i) = aNumeri(i)
aTmpRit(i) = aFreqNum(aNumeri(i))
Next
For a = 1 To k - 1
For b = 1 To k - a
If aTmpRit(b) < aTmpRit(b + 1) Then
tmpS = aTmpRit(b) : aTmpRit(b) = aTmpRit(b + 1) : aTmpRit(b + 1) = tmpS
tmpNN = aTmpNum(b) : aTmpNum(b) = aTmpNum(b + 1) : aTmpNum(b + 1) = tmpNN
End If
Next
Next
For i = 1 To k
Scrivi FormatSpace(Format2(aTmpNum(i)), 4, False) & " | Presenze in eventi Q/C: " & aTmpRit(i)
Next
Scrivi "--------------------------------------------------------------------------------"
Scrivi "Scansione completata. Totale eventi trovati: " & cTotEventi
ColoreTesto 0
' --- METODO PREVISIVO: RITARDO SULLA MASSA, PER RUOTA ---
ColoreTesto 2
Scrivi "--------------------------------------------------------------------------------"
Scrivi " METODO PREVISIVO (Ritardo sulla massa numerica, per ruota)"
Scrivi " Ritardo = estrazioni trascorse dall'ultima comparsa in un evento Q/C su quella ruota"
Scrivi "--------------------------------------------------------------------------------"
ColoreTesto 1
For nRuotaIdx = 1 To 11
For i = 1 To k
nNumIdx = aNumeri(i)
If aUltimaUscita(nRuotaIdx, nNumIdx) = 0 Then
aRitardo(nRuotaIdx, nNumIdx) = EstrazioniArchivio - 3549 + 1
Else
aRitardo(nRuotaIdx, nNumIdx) = EstrazioniArchivio - aUltimaUscita(nRuotaIdx, nNumIdx)
End If
Next
For i = 1 To k
aTmpNum(i) = aNumeri(i)
aTmpRit(i) = aRitardo(nRuotaIdx, aNumeri(i))
Next
For a = 1 To k - 1
For b = 1 To k - a
If aTmpRit(b) < aTmpRit(b + 1) Then
tmpS = aTmpRit(b) : aTmpRit(b) = aTmpRit(b + 1) : aTmpRit(b + 1) = tmpS
tmpNN = aTmpNum(b) : aTmpNum(b) = aTmpNum(b + 1) : aTmpNum(b + 1) = tmpNN
End If
Next
Next
Scrivi FormatSpace(NomeRuota(nRuotaIdx), 10, False) & " | Top 10 ritardatari (dalla massa): "
sRiga = " "
If k < 10 Then nLimit = k Else nLimit = 10
For i = 1 To nLimit
sRiga = sRiga & Format2(aTmpNum(i)) & "(" & aTmpRit(i) & ") "
Next
Scrivi sRiga
Next
Scrivi "--------------------------------------------------------------------------------"
Scrivi "NB: il ritardo è calcolato SOLO sulle uscite in eventi di quaterna/cinquina."
ColoreTesto 0
End Sub
' --- FUNZIONI DI SUPPORTO ---
Function Sme_InVettore(n, aVett)
Dim i
Sme_InVettore = False
For i = 1 To UBound(aVett)
If aVett(i) = n Then
Sme_InVettore = True
Exit Function
End If
Next
End Function
Function VerificaFiltro(dec, cad, sDec, sCad)
Dim bDecTrovata, bCadTrovata
Dim aD, aC, j
bDecTrovata = False
bCadTrovata = False
If Trim(sDec) <> "" Then
aD = Split(sDec, ",")
For j = 0 To UBound(aD)
If CInt(Trim(aD(j))) = dec Then
bDecTrovata = True
Exit For
End If
Next
End If
If Trim(sCad) <> "" Then
aC = Split(sCad, ",")
For j = 0 To UBound(aC)
If CInt(Trim(aC(j))) = cad Then
bCadTrovata = True
Exit For
End If
Next
End If
VerificaFiltro = (bDecTrovata Or bCadTrovata)
End Function
