Script ritardo di casella

[simimi]

Buongiorno a tutti,
ho ritrovato questo vecchio script che non ricordo di chi sia, però mi va in errore.
Mi potreste aiutare a capire qual'è la routine che non funziona?
Grazie e buona giornata a tutti

simimi

' ============================================================
' SCRIPT: RITARDO DI CASELLA
' Compatibile con: Spaziometria e L8+
' Analisi: Tutte le ruote - Tutte le caselle (1° - 5° estratto)
' Descrizione: Per ogni ruota e per ogni casella (posizione),
' calcola quante estrazioni sono passate dall'ultima
' volta che ciascun numero (1-90) è uscito in
' quella specifica casella.
' ============================================================

Sub Main()

' --- PARAMETRI MODIFICABILI ---
Dim soglia As Integer
soglia = 50 ' Mostra solo numeri con ritardo >= a questo valore
' (metti 0 per vedere tutti i numeri)

' --- VARIABILI ---
Dim ruota As Integer
Dim casella As Integer
Dim numero As Integer
Dim es As Integer
Dim ultimaVolta As Integer
Dim ritardo As Integer
Dim estratto As Integer
Dim totEstr As Integer
Dim nomeRuota As String
Dim intestazione As String

totEstr = EstrazioneFin ' ultima estrazione disponibile in archivio

' --- INTESTAZIONE OUTPUT ---
Scrivi "============================================================", 1
Scrivi " RITARDO DI CASELLA - TUTTE LE RUOTE - TUTTE LE CASELLE", 1
Scrivi " Soglia ritardo: " & soglia & " estrazioni", 1
Scrivi " Estrazioni analizzate: " & totEstr, 1
Scrivi "============================================================", 1
Scrivi "", 1

' --- CICLO SU TUTTE LE RUOTE (1=BA ... 11=NZ) ---
For ruota = 1 To 11

nomeRuota = SiglaRuota(ruota)

Scrivi "------------------------------------------------------------", 1
Scrivi " RUOTA: " & nomeRuota, 1
Scrivi "------------------------------------------------------------", 1
Scrivi " Casella | Numero | Ritardo attuale", 1
Scrivi "------------------------------------------------------------", 1

' --- CICLO SU TUTTE LE CASELLE (1=1° estratto ... 5=5° estratto) ---
For casella = 1 To 5

' --- CICLO SU TUTTI I NUMERI (1-90) ---
For numero = 1 To 90

ultimaVolta = 0 ' reset: 0 = numero mai uscito in questa casella

' --- SCANSIONE ARCHIVIO DALLA PIU' RECENTE ALLA PIU' VECCHIA ---
For es = totEstr To 1 Step -1

estratto = Estratto(es, ruota, casella)

If estratto = numero Then
ultimaVolta = es
Exit For ' trovata l'ultima volta: uscita dal ciclo
End If

Next es

' --- CALCOLO RITARDO ---
If ultimaVolta = 0 Then
ritardo = totEstr ' mai uscito: ritardo = tutte le estrazioni
Else
ritardo = totEstr - ultimaVolta
End If

' --- OUTPUT SOLO SE SUPERA LA SOGLIA ---
If ritardo >= soglia Then
Scrivi " Casella " & casella & " | " & Format2(numero) & " | " & ritardo & " estrazioni", 1
End If

Next numero

Next casella

Scrivi "", 1

Next ruota

' --- FINE ---
Scrivi "============================================================", 1
Scrivi " ANALISI COMPLETATA", 1
Scrivi "============================================================", 1

End Sub

 

[simimi]

nessuno ha la soluzione?

 

[Venuslotto]

Prova questo script del bravo mike58

Sub Main()
Dim num(10),numero(10),ruota(1),sorte

est = InputBox("Quante estrazioni analizzi",,10293)
sorte = CInt(InputBox("Quale sorte verificare ",,1))

ScegliNumeri(num)
nStart = Timer ' partenza tempo di elaborazione
Ini = EstrazioneFin - est
fin = EstrazioneFin
diff = fin - Ini + 1
Scrivi"Statistica Veloce su combinazione di Numeri scelti" & " ",True,False,6,0,3
Scrivi" " & StringaNumeri(num) & " ",True,False,2,4,3
Scrivi" Per sorte..." & " " & NomeSorte(sorte) & " ",True,True,3,0,3
Scrivi String(130,"=")
Scrivi " Dalla data..." & DataEstrazione(Ini) & " alla data..." & DataEstrazione(fin) & " - Estrazioni Totali " & DIFF,1
Scrivi String(130,"=")
Scrivi
'--------- crea tabella---------------
ReDim atitoli(15)
atitoli(1) = " Ruota "
'atitoli(2) = " Combinazione "
atitoli(3) = " RD1 "
atitoli(4) = " RD2 "
atitoli(5) = " RD3 "
atitoli(6) = " RD4 "
atitoli(7) = " RD5 "
atitoli(8) = " Ritardo attuale "
atitoli(9) = " Ritardo Storico "
atitoli(10) = " incr. storico "
atitoli(11) = " Frequenza "
atitoli(12) = " - esito - "
atitoli(13) = " - stringa Esito - "
atitoli(14) = " data estraz.uscita "
atitoli(15) = " Indice Convenienza "
' inizializzo la tabella
Call InitTabella(atitoli,1,,3,5)
For r = 1 To 12
'If r = 11 Then r = 12
ruota(1) = r
Call AvanzamentoElab(Ini,fin,n)
If ScriptInterrotto Then Exit For
Call StatisticaFormazione(num,ruota,sorte,rit,ritmax,incrRitMax,freq,Ini,fine)
Call VerificaEsito(num,ruota,fin - rit,sorte,1,,retesito,retcolpi,retestratti,retidestr)
ic = Round((freq/diff*rit),2)
'----- calcolo valori in tabella --------------
ReDim avalori(15)
avalori(1) = NomeRuota(r)
avalori(3) = RitDiPos(num,1,ruota)
avalori(4) = RitDiPos(num,2,ruota)
avalori(5) = RitDiPos(num,3,ruota)
avalori(6) = RitDiPos(num,4,ruota)
avalori(7) = RitDiPos(num,5,ruota)
avalori(8) = rit
avalori(9) = ritmax
avalori(10) = incrRitMax
avalori(11) = freq
avalori(12) = retesito
avalori(13) = retestratti
If retesito <> "" Then avalori(14) = DataEstrazione(retidestr)
If retesito = "" Then avalori(14) = " -- "
avalori(15) = ic
Call AddRigaTabella(avalori,,,3,,"cambria")
If r = 11 Then Call SetColoreCella(11,3,1)
If retidestr = fin Then Call SetColoreCella(14,3,1)
If ic > 1 Then Call SetColoreCella(15,4,2)
Next
Call SetTableWidth("100%")
Call CreaTabella()
Scrivi " Script By Mike58 ",1,- 1,6
nend = Timer
Call Scrivi("Tempo di elaborazione : " & FormattaSecondi((nend + 1) - nstart))
End Sub
Function RitDiPos(num,pos,ruota)
ReDim apos(5)
ReDim aruota(1)
ReDim anum(1)
anum(1) = num
apos(pos) = True
aruota(1) = ruota
RitDiPos = RitardoCombinazione(ruota,num,1,0,apos)
End Function
Function FormattaSecondi(s)
'Questa Function trasforma il numero di secondi passato come parametro in una stringa
' passando i secondi si ottengono ore minuti e secondi in formato hh:mm:ss
' s ---> Numero di secondi da formattare
' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
Dim hh
Dim Mm
Dim Ss
Dim TimeStr
hh = s \ 3600
Mm =(s Mod 3600) \ 60
Ss = s -((hh * 3600) +(Mm * 60))
TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
FormattaSecondi = TimeStr
End Function

 

[simimi]

Grazie mille Venuslotto