Ciao a tutti, avevo su una chiavetta, che adesso non si apre più, un listato realizzato da LuigiB. Non ricordo esattamente il nome dello script, ma era uno script che forniva delle formazioni a scelta (ambo, terno, quaterna) a garanzia (sempre a scelta) di estratto o ambo o terno, analizzando un tot di ultime estrazioni impostabili a piacere. Qualcuno che se lo ritrova gentilmente potrebbe pubblicarlo ?
Buon pomerigggio,
in base a quanto hai scritto ho realizzato questo script perche' quello di LuigiB. non lo trovo neanche io
Sub Main()
Dim Nuove, Ruota, TipoFormazione, EsitoCercato, QEstrazioni
Dim Inizio, Fine, Rit, Max, Inc, Fre, Sorte
Dim aRuote(1)
' --- INPUT UTENTE ---
Ruota = InputBox("Inserisci il numero della Ruota (1=Ba, 2=Ca, ..., 10=Ve, 11=Nazionale)", "SELEZIONE RUOTA", 1)
TipoFormazione = InputBox("Scegli la formazione da analizzare:" & vbCrLf & "2 = Ambi" & vbCrLf & "3 = Terzine" & vbCrLf & "4 = Quartine" & vbCrLf & "5 = Cinquine", "TIPO FORMAZIONE", 2)
EsitoCercato = InputBox("Scegli la garanzia/esito minimo cercato:" & vbCrLf & "1 = Estratto" & vbCrLf & "2 = Ambo" & vbCrLf & "3 = Terno", "GARANZIA ESITO", 1)
QEstrazioni = InputBox("Quante ultime estrazioni vuoi analizzare?", "RANGE ESTRAZIONI", 100)
' Converti input in numeri
Ruota = CInt(Ruota)
TipoFormazione = CInt(TipoFormazione)
EsitoCercato = CInt(EsitoCercato)
QEstrazioni = CInt(QEstrazioni)
' Configurazione Range Temporale
Fine = EstrazioneMax
Inizio = (Fine - QEstrazioni) + 1
aRuote(1) = Ruota
Scrivi "--- ANALISI FORMAZIONI A GARANZIA ---", 1
Scrivi "Ruota di analisi: " & NomeRuota(Ruota), 1
Scrivi "Periodo: dal " & DataEstrazione(Inizio) & " al " & DataEstrazione(Fine) & " (" & QEstrazioni & " estrazioni)", 0
Scrivi "Formazione scelta: " & TipoFormazione & " numeri", 0
Scrivi "Esito/Garanzia cercata: " & NomeSorte(EsitoCercato), 0
Scrivi String(60, "-")
Scrivi ""
' Validazione input per evitare loop infiniti o crash
If TipoFormazione < EsitoCercato Then
MsgBox "Errore: La formazione scelta non può essere inferiore all'esito cercato!", vbCritical, "Errore Input"
Exit Sub
End If
' --- INIZIO ELABORAZIONE COMBINATORIA ---
' Usiamo lo sviluppo combinatorio nativo di Spaziometria per i 90 numeri
Dim aNumeri(90)
Dim nClasse
Dim aCol
For n = 1 To 90
aNumeri
= n
Next
nClasse = TipoFormazione
' Inizializza lo sviluppo delle combinazioni
If InitSviluppoIntegrale(aNumeri, nClasse) > 0 Then
Dim Contatore, Trovate
Contatore = 0
Trovate = 0
' Messaggio di attesa (il calcolo per quartine/cinquine potrebbe richiedere tempo)
Scrivi "Elaborazione in corso... Attendere.", 1, , vbRed
Do While GetCombSviluppo(aCol)
Contatore = Contatore + 1
' Verifica Statistica della combinazione nel range impostato
' StatisticaFormazione(combinazione, ruote, sorte, ritardo, ritardomax, incmax, frequenza, inizio, fine)
Call StatisticaFormazione(aCol, aRuote, EsitoCercato, Rit, Max, Inc, Fre, Inizio, Fine)
' Se il Ritardo Attuale è 0, significa che la formazione ha PAGATO l'esito cercato nell'ultima estrazione
' Se vogliamo che abbia garantito ALMENO una presenza nel periodo, controlliamo la Frequenza > 0
' In questo caso filtriamo le formazioni che hanno avuto FREQUENZA massima o che coprono i criteri
If Fre > 0 Then
' Per evitare liste chilometriche, stampiamo le combinazioni più frequenti o con ritardo azzerato
' Puoi personalizzare questo filtro. Qui mostriamo quelle con almeno 1 sfaldamento nel periodo.
Trovate = Trovate + 1
Scrivi "Formazione: " & StringaNumeri(aCol) & " -> Presenze (Frequenza) nel periodo: " & Fre & " | Ritardo Attuale: " & Rit
End If
' Gestione memoria e feedback visivo ogni 50.000 combinazioni
If Contatore Mod 50000 = 0 Then
Call MessaggioInForm("Combinazioni elaborate: " & Contatore)
If AvanzamentoElab(0, 100, 50) Then Exit Do
End If
Loop
Scrivi ""
Scrivi String(60, "-")
Scrivi "Totale combinazioni analizzate: " & Contatore
Scrivi "Totale combinazioni con esito positivo: " & Trovate
End If
End Sub
Function NomeSorte(Sorte)
Dim Ret
Select Case Sorte
Case 1: Ret = "Estratto"
Case 2: Ret = "Ambo"
Case 3: Ret = "Terno"
Case 4: Ret = "Quaterna"
Case 5: Ret = "Cinquina"
End Select
NomeSorte = Ret
End Function
