Pandit
Super Member >GOLD<
Ho trovato questo script in rete e mi pare interessante, ma non funziona, qualche scripter con tanta pazienza riesce a sistemarlo??
Grazie per tutti quelli che lo useranno..
Grazie per tutti quelli che lo useranno..
Sub Main()
' --- Impostazioni Utente ---
Const NUM_ESTRAZIONI_ANALISI = 20 ' Numero di estrazioni da analizzare
' --- Input Ruote da Analizzare ---
Dim ruota1, ruota2
ruota1 = CInt(InputBox("Inserisci il numero della PRIMA ruota da analizzare (1-12, dove 11=Nazionale, 12=Tutte):", "Selezione Ruota 1", 1))
If ruota1 < 1 Or ruota1 > 12 Then
MsgBox "Numero ruota 1 non valido. Lo script verrà terminato."
Exit Sub
End If
Dim risposta
risposta = MsgBox("Vuoi analizzare anche una SECONDA ruota?", vbYesNo + vbQuestion, "Seconda Ruota?")
If risposta = vbYes Then
ruota2 = CInt(InputBox("Inserisci il numero della SECONDA ruota da analizzare (1-12):", "Selezione Ruota 2", 2))
If ruota2 < 1 Or ruota2 > 12 Then
MsgBox "Numero ruota 2 non valido. Lo script verrà terminato."
Exit Sub
End If
Else
ruota2 = 0 ' Nessuna seconda ruota selezionata
End If
' --- Inizializzazione Variabili per Analisi ---
Dim fin
fin = EstrazioneFin ' Ultima estrazione disponibile
Dim ini
ini = fin - NUM_ESTRAZIONI_ANALISI + 1 ' Estrazione iniziale del periodo
' Variabili per tenere traccia della "migliore" sestina
Dim miglioreSestinaNum
miglioreSestinaNum = 0
Dim miglioreSestinaNumeroRipetuto
miglioreSestinaNumeroRipetuto = 0
Dim maxOccorrenze
maxOccorrenze = 0
Dim numeriSestinaMigliore(1 , 6)
' --- Intestazione Output ---
ColoreTesto 1 ' Colore rosso per il titolo
Scrivi String(90, "="), 1
Scrivi " Analisi di TUTTE le 15 Sestine Esagonali ", 1
Dim sRuoteAnalizzate
sRuoteAnalizzate = SiglaRuota(ruota1)
If ruota2 <> 0 Then
sRuoteAnalizzate = sRuoteAnalizzate & ", " & SiglaRuota(ruota2)
End If
Scrivi " Ruota/e Analizzata/e: " & sRuoteAnalizzate, 1
Scrivi " Periodo Analizzato: Ultime " & NUM_ESTRAZIONI_ANALISI & " Estrazioni", 1
Scrivi String(90, "="), 1
ColoreTesto 0 ' Torna al colore predefinito
' --- Loop su tutte le 15 sestine esagonali ---
Dim numSestinaScelta
For numSestinaScelta = 1 To 15
' --- Costruzione Sestina Esagonale ---
Dim sestina(1 , 6)
Dim baseSestina
baseSestina = numSestinaScelta ' Il numero di partenza per la sestina
Dim i
For i = 1 To 6
sestina(i) = Fuori90(baseSestina + (i - 1) * 15) ' Calcola i 6 numeri della sestina con passo 15
Next
Dim occorrenzeGlobali : Set occorrenzeGlobali = CreateObject("Scripting.Dictionary")
Dim num
For Each num In sestina
If num <> 0 Then
occorrenzeGlobali(num) = 0
End If
Next
' --- Analisi delle Estrazioni per la sestina corrente ---
Dim es
For es = ini To fin
AvanzamentoElab ini, fin, es ' Mostra l'avanzamento
Dim p
' Analisi Ruota 1
For p = 1 To 5 ' Itera sulle posizioni degli estratti
Dim estratto1
estratto1 = Estratto(es, ruota1, p)
If occorrenzeGlobali.Exists(estratto1) Then
occorrenzeGlobali(estratto1) = occorrenzeGlobali(estratto1) + 1
End If
Next
' Analisi Ruota 2 (se selezionata)
If ruota2 <> 0 Then
For p = 1 To 5
Dim estratto2
estratto2 = Estratto(es, ruota2, p)
If occorrenzeGlobali.Exists(estratto2) Then
occorrenzeGlobali(estratto2) = occorrenzeGlobali(estratto2) + 1
End If
Next
End If
Next
' --- Valutazione della Sestina Corrente ---
Dim currentMaxOcc
currentMaxOcc = 0
Dim currentRepeatedNum
currentRepeatedNum = 0
Dim sMancanti
sMancanti = ""
Dim numeriMancantiCount
numeriMancantiCount = 0
For Each num In sestina
If num <> 0 Then
If occorrenzeGlobali.Exists(num) Then
If occorrenzeGlobali(num) > currentMaxOcc Then
currentMaxOcc = occorrenzeGlobali(num)
currentRepeatedNum = num
End If
If occorrenzeGlobali(num) = 0 Then
sMancanti = sMancanti & Format2(num) & " "
numeriMancantiCount = numeriMancantiCount + 1
End If
End If
End If
Next
' Stampa i risultati per la sestina corrente
Scrivi vbCrLf & String(80, "-"), 1
Scrivi "Sestina N° " & numSestinaScelta & " ( " & JoinSestina(sestina) & " )", 1
If currentMaxOcc >= 2 Then ' Un numero è ripetuto almeno due volte
ColoreTesto 4
Scrivi " Numero più ripetuto: " & Format2(currentRepeatedNum) & " con " & currentMaxOcc & " occorrenze.", 1
Else
ColoreTesto 0
Scrivi " Nessun numero della sestina ripetuto (almeno 2 volte) nel periodo.", 1
End If
If numeriMancantiCount > 0 Then
ColoreTesto 6
Scrivi " Numeri Mancanti dalla sestina: " & sMancanti, 1
Else
ColoreTesto 0
Scrivi " Tutti i numeri della sestina sono usciti almeno una volta nel periodo.", 1
End If
ColoreTesto 0
' Aggiorna la migliore sestina globale
If currentMaxOcc > maxOccorrenze Then
maxOccorrenze = currentMaxOcc
miglioreSestinaNum = numSestinaScelta
miglioreSestinaNumeroRipetuto = currentRepeatedNum
For i = 1 To 6
numeriSestinaMigliore(i) = sestina(i)
Next
End If
Next
' --- Stampa Riepilogo Generale della Migliore Sestina ---
Scrivi vbCrLf & String(90, "="), 1
Scrivi " RIEPILOGO FINALE GENERALE ", 1
Scrivi String(90, "="), 1
If miglioreSestinaNum <> 0 Then
ColoreTesto 2 ' Colore verde per la migliore sestina
Scrivi "La migliore sestina per presenza di un numero singolo ripetuto è:", 1
Scrivi "Sestina N° " & miglioreSestinaNum & " ( " & JoinSestina(numeriSestinaMigliore) & " )", 1
Scrivi "Il numero " & Format2(miglioreSestinaNumeroRipetuto) & " è uscito " & maxOccorrenze & " volte.", 1
ColoreTesto 0
Else
Scrivi "Nel periodo analizzato, nessuna sestina ha avuto un numero singolo ripetuto almeno 2 volte.", 1
End If
Scrivi String(90, "="), 1
ScriviResoconto
End Sub
' --- Funzioni Ausiliarie ---
' Funzione per formattare la sestina per la visualizzazione
Function JoinSestina(arrSestina)
Dim sTemp
sTemp = ""
Dim i
For i = 1 To UBound(arrSestina)
sTemp = sTemp & Format2(arrSestina(i)) & IIf(i < UBound(arrSestina), ", ", "")
Next
JoinSestina = sTemp
End Function
' --- Impostazioni Utente ---
Const NUM_ESTRAZIONI_ANALISI = 20 ' Numero di estrazioni da analizzare
' --- Input Ruote da Analizzare ---
Dim ruota1, ruota2
ruota1 = CInt(InputBox("Inserisci il numero della PRIMA ruota da analizzare (1-12, dove 11=Nazionale, 12=Tutte):", "Selezione Ruota 1", 1))
If ruota1 < 1 Or ruota1 > 12 Then
MsgBox "Numero ruota 1 non valido. Lo script verrà terminato."
Exit Sub
End If
Dim risposta
risposta = MsgBox("Vuoi analizzare anche una SECONDA ruota?", vbYesNo + vbQuestion, "Seconda Ruota?")
If risposta = vbYes Then
ruota2 = CInt(InputBox("Inserisci il numero della SECONDA ruota da analizzare (1-12):", "Selezione Ruota 2", 2))
If ruota2 < 1 Or ruota2 > 12 Then
MsgBox "Numero ruota 2 non valido. Lo script verrà terminato."
Exit Sub
End If
Else
ruota2 = 0 ' Nessuna seconda ruota selezionata
End If
' --- Inizializzazione Variabili per Analisi ---
Dim fin
fin = EstrazioneFin ' Ultima estrazione disponibile
Dim ini
ini = fin - NUM_ESTRAZIONI_ANALISI + 1 ' Estrazione iniziale del periodo
' Variabili per tenere traccia della "migliore" sestina
Dim miglioreSestinaNum
miglioreSestinaNum = 0
Dim miglioreSestinaNumeroRipetuto
miglioreSestinaNumeroRipetuto = 0
Dim maxOccorrenze
maxOccorrenze = 0
Dim numeriSestinaMigliore(1 , 6)
' --- Intestazione Output ---
ColoreTesto 1 ' Colore rosso per il titolo
Scrivi String(90, "="), 1
Scrivi " Analisi di TUTTE le 15 Sestine Esagonali ", 1
Dim sRuoteAnalizzate
sRuoteAnalizzate = SiglaRuota(ruota1)
If ruota2 <> 0 Then
sRuoteAnalizzate = sRuoteAnalizzate & ", " & SiglaRuota(ruota2)
End If
Scrivi " Ruota/e Analizzata/e: " & sRuoteAnalizzate, 1
Scrivi " Periodo Analizzato: Ultime " & NUM_ESTRAZIONI_ANALISI & " Estrazioni", 1
Scrivi String(90, "="), 1
ColoreTesto 0 ' Torna al colore predefinito
' --- Loop su tutte le 15 sestine esagonali ---
Dim numSestinaScelta
For numSestinaScelta = 1 To 15
' --- Costruzione Sestina Esagonale ---
Dim sestina(1 , 6)
Dim baseSestina
baseSestina = numSestinaScelta ' Il numero di partenza per la sestina
Dim i
For i = 1 To 6
sestina(i) = Fuori90(baseSestina + (i - 1) * 15) ' Calcola i 6 numeri della sestina con passo 15
Next
Dim occorrenzeGlobali : Set occorrenzeGlobali = CreateObject("Scripting.Dictionary")
Dim num
For Each num In sestina
If num <> 0 Then
occorrenzeGlobali(num) = 0
End If
Next
' --- Analisi delle Estrazioni per la sestina corrente ---
Dim es
For es = ini To fin
AvanzamentoElab ini, fin, es ' Mostra l'avanzamento
Dim p
' Analisi Ruota 1
For p = 1 To 5 ' Itera sulle posizioni degli estratti
Dim estratto1
estratto1 = Estratto(es, ruota1, p)
If occorrenzeGlobali.Exists(estratto1) Then
occorrenzeGlobali(estratto1) = occorrenzeGlobali(estratto1) + 1
End If
Next
' Analisi Ruota 2 (se selezionata)
If ruota2 <> 0 Then
For p = 1 To 5
Dim estratto2
estratto2 = Estratto(es, ruota2, p)
If occorrenzeGlobali.Exists(estratto2) Then
occorrenzeGlobali(estratto2) = occorrenzeGlobali(estratto2) + 1
End If
Next
End If
Next
' --- Valutazione della Sestina Corrente ---
Dim currentMaxOcc
currentMaxOcc = 0
Dim currentRepeatedNum
currentRepeatedNum = 0
Dim sMancanti
sMancanti = ""
Dim numeriMancantiCount
numeriMancantiCount = 0
For Each num In sestina
If num <> 0 Then
If occorrenzeGlobali.Exists(num) Then
If occorrenzeGlobali(num) > currentMaxOcc Then
currentMaxOcc = occorrenzeGlobali(num)
currentRepeatedNum = num
End If
If occorrenzeGlobali(num) = 0 Then
sMancanti = sMancanti & Format2(num) & " "
numeriMancantiCount = numeriMancantiCount + 1
End If
End If
End If
Next
' Stampa i risultati per la sestina corrente
Scrivi vbCrLf & String(80, "-"), 1
Scrivi "Sestina N° " & numSestinaScelta & " ( " & JoinSestina(sestina) & " )", 1
If currentMaxOcc >= 2 Then ' Un numero è ripetuto almeno due volte
ColoreTesto 4
Scrivi " Numero più ripetuto: " & Format2(currentRepeatedNum) & " con " & currentMaxOcc & " occorrenze.", 1
Else
ColoreTesto 0
Scrivi " Nessun numero della sestina ripetuto (almeno 2 volte) nel periodo.", 1
End If
If numeriMancantiCount > 0 Then
ColoreTesto 6
Scrivi " Numeri Mancanti dalla sestina: " & sMancanti, 1
Else
ColoreTesto 0
Scrivi " Tutti i numeri della sestina sono usciti almeno una volta nel periodo.", 1
End If
ColoreTesto 0
' Aggiorna la migliore sestina globale
If currentMaxOcc > maxOccorrenze Then
maxOccorrenze = currentMaxOcc
miglioreSestinaNum = numSestinaScelta
miglioreSestinaNumeroRipetuto = currentRepeatedNum
For i = 1 To 6
numeriSestinaMigliore(i) = sestina(i)
Next
End If
Next
' --- Stampa Riepilogo Generale della Migliore Sestina ---
Scrivi vbCrLf & String(90, "="), 1
Scrivi " RIEPILOGO FINALE GENERALE ", 1
Scrivi String(90, "="), 1
If miglioreSestinaNum <> 0 Then
ColoreTesto 2 ' Colore verde per la migliore sestina
Scrivi "La migliore sestina per presenza di un numero singolo ripetuto è:", 1
Scrivi "Sestina N° " & miglioreSestinaNum & " ( " & JoinSestina(numeriSestinaMigliore) & " )", 1
Scrivi "Il numero " & Format2(miglioreSestinaNumeroRipetuto) & " è uscito " & maxOccorrenze & " volte.", 1
ColoreTesto 0
Else
Scrivi "Nel periodo analizzato, nessuna sestina ha avuto un numero singolo ripetuto almeno 2 volte.", 1
End If
Scrivi String(90, "="), 1
ScriviResoconto
End Sub
' --- Funzioni Ausiliarie ---
' Funzione per formattare la sestina per la visualizzazione
Function JoinSestina(arrSestina)
Dim sTemp
sTemp = ""
Dim i
For i = 1 To UBound(arrSestina)
sTemp = sTemp & Format2(arrSestina(i)) & IIf(i < UBound(arrSestina), ", ", "")
Next
JoinSestina = sTemp
End Function
