Ho trovato questo script..

[Pandit]

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..

Anticipazione (Spoiler)

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

 

[phil79]

c'è un errore quando crea la sestina....intervallo ecc..... io non saprei

 

[salvo50]

Ciao a Tutti
Questo non è un semplice script, secondo me quelli che possono
capirlo in questo forum, sono ben pochi.

Nello script c'è questa riga

For Each num In sestina

Qualche tempo fa, LuigiB, ci aveva spiegato che è un FOR-NEXT
che si usa per cose più complesse, io allora non ci avevo
capito un tubo.

Penso che Joe oppure Claudio8 oppure Enplein ed altri che non ricordo i nomi, possono risolverlo
non ho menzionato Mike58 e I Legend perchè è un bel po' che non li vedo nel forum

 

[Pandit]

Come sempre salvo50 ci salvi, grazie, spero che uno di loro ci dia un'occhio.
Grazie, io non ci ho capito molto, ma come ho detto mi pare interessante..

 

[phil79]

Il problema è qui
baseSestina = numSestinaScelta ' Il numero di partenza per la sestina

 

[batty]

il codice dopo aver chiesto le due ruote crea ed analizza 1000 sestine a distanza 15,
e stampa l'output nel browser.

ha mio avviso non è un gran che!. comunque : l'ho corretto per vb6.
allego il codice , per l'utilizzo va rinominato in Cercasestine.bas
dopo di che basta caricarlo nell'ide di vb6 insieme alla libreria Modspazioscript.bas e farlo girare .
'IL presente codice gira regolarmente in visualBasic6 con
'la libreria "modSpazioScript.bas" di spaziometria caricata.
'l'editor di spaziometria utilizza il vbScript come linguaggio che è sostanzialmente diverso
'quindi presenta degli errori che vanno analizzati e corretti !.
SE non si possiede il vb6 ne ho allegato una versione già compilata è sufficente rinominarlo togliendo l'estensione .txt e lasciare il solo "nomefile.exe" e lanciarlo come un qualsiasi altro programma ovviamente serve spaziometria installata ne pc.

 

[Pandit]

io avevo capito che analizzava le sestine simmetriche, che sono 15 e mi pareva interessante trovare i numeri ripetuti e quelli mancanti da mettere in gioco, ma grazie per l'exe.

 

[phil79]

Troppo laborioso non serve a nulla secondo me