Option Explicit
Class clsParStat
Dim idEstr
Dim RitMax
Dim IncrRitMax
End Class
Sub Main
Dim idEstr,Ruota,Sorte
Dim Inizio,Fine
Dim k,p,i,r,pMax
Dim Rit,RitMax,IncRitMax,Fre
Dim collStoria
Dim cParStat
Dim bEstrValida
Set collStoria = GetNewCollection
Inizio = EstrazioneIni
Fine = EstrazioneFin
ReDim aN(90)
If ScegliFormazione(aN) Then
ReDim aRuoteSel(12)
Ruota = ScegliRuotaEx (aRuoteSel)
Sorte = ScegliEsito
If Ruota > 0 And Sorte > 0 Then
For idEstr = Inizio To Fine
If Ruota = 11 Then
bEstrValida = False
pMax = 0
For r = 1 To 10
If Estratto(idEstr,r,1) > 0 Then bEstrValida = True
p = 0
For k = 1 To 5
If aN(Estratto(idEstr,r,k)) Then
p = p + 1
End If
Next
If p > pMax Then pMax = p
Next
If bEstrValida Then
If pMax >= Sorte Then
If IncRitMax > 0 Then
Set cParStat = New clsParStat
cParStat.IdEstr = idEstr - 1
cParStat.RitMax = RitMax
cParStat.IncrRitMax = IncRitMax
collStoria.add cParStat
End If
Rit = 0
Fre = Fre + 1
IncRitMax = 0
Else
Rit = Rit + 1
If Rit > RitMax Then
IncRitMax = IncRitMax + 1
RitMax = Rit
End If
End If
End If
ElseIf Ruota = 13 Then
bEstrValida = False
pMax = 0
For r = 1 To 12
If aRuoteSel(r) Then
If Estratto(idEstr,r,1) > 0 Then bEstrValida = True
p = 0
For k = 1 To 5
If aN(Estratto(idEstr,r,k)) Then
p = p + 1
End If
Next
If p > pMax Then pMax = p
End If
Next
If bEstrValida Then
If pMax >= Sorte Then
If IncRitMax > 0 Then
Set cParStat = New clsParStat
cParStat.IdEstr = idEstr - 1
cParStat.RitMax = RitMax
cParStat.IncrRitMax = IncRitMax
collStoria.add cParStat
End If
Rit = 0
Fre = Fre + 1
IncRitMax = 0
Else
Rit = Rit + 1
If Rit > RitMax Then
IncRitMax = IncRitMax + 1
RitMax = Rit
End If
End If
End If
Else
If Estratto(idEstr,Ruota,1) > 0 Then
p = 0
For k = 1 To 5
If aN(Estratto(idEstr,Ruota,k)) Then
p = p + 1
End If
Next
If p >= Sorte Then
If IncRitMax > 0 Then
Set cParStat = New clsParStat
cParStat.IdEstr = idEstr - 1
cParStat.RitMax = RitMax
cParStat.IncrRitMax = IncRitMax
collStoria.add cParStat
End If
Rit = 0
Fre = Fre + 1
IncRitMax = 0
Else
Rit = Rit + 1
If Rit > RitMax Then
IncRitMax = IncRitMax + 1
RitMax = Rit
End If
End If
End If
End If
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
If IncRitMax > 0 Then
Set cParStat = New clsParStat
cParStat.IdEstr = idEstr - 1
cParStat.RitMax = RitMax
cParStat.IncrRitMax = IncRitMax
collStoria.add cParStat
End If
Call GestioneOutput(collStoria,RitMax,aN,Sorte,Inizio,Fine,Ruota,Rit,Fre ,aRuoteSel)
Else
MsgBox "Ruota non valida"
End If
End If
End Sub
Function ScegliFormazione(aN)
Dim sFormazione
Dim k,i
sFormazione = InputBox("Inserire la formazione da analizzare separando i numeri che la compongono con il punto",,"1.10.20")
ReDim aV(0)
Call SplitByChar(sFormazione,".",aV)
For k = 0 To UBound(aV)
If Int(aV(k)) > 0 And Int(aV(k)) <= 90 Then
aN(Int(aV(k))) = True
i = i + 1
End If
Next
If i > 0 Then ScegliFormazione = True
End Function
Sub GestioneOutput(coll,RitMax,aN,Sorte,Inizio,Fine,Ruota,Rit,Fre ,aRuoteSel)
Dim x,y,k
Dim sFrz
Dim clsP
For k = 1 To 90
If aN(k) Then
sFrz = sFrz & Format2(k) & "."
End If
Next
sFrz = Left(sFrz,Len(sFrz) - 1)
If Ruota = 13 Then
Call Scrivi("Sulla ruota di : " & GetStringaRuote (aRuoteSel ))
Else
Call Scrivi("Sulla ruota di : " & NomeRuota(Ruota))
End If
Call Scrivi("Formazione analizzata : " & sFrz)
Call Scrivi("Da Estrazione : " & GetInfoEstrazione(Inizio))
Call Scrivi("A Estrazione : " & GetInfoEstrazione(Fine))
Call Scrivi
Call Scrivi("Ritardo : " & Rit)
Call Scrivi("RitardoMax : " & RitMax)
Call Scrivi("Frequenza : " & Fre)
Call Scrivi
Call Scrivi("Dettaglio evoluzione RitMax",True)
For Each clsP In coll
Call Scrivi("Estrazione : " & FormatSpace(clsP.idEstr,5,True) & _
" RitMax : " & FormatSpace(clsP.RitMax,5,True) & _
" InccrRitMax : " & FormatSpace(clsP.IncrRitMax,5,True))
Next
Call Scrivi
Call Scrivi("Grafico di confronto RitMax / IncRitMax",True)
Call PreparaGrafico("",0,coll.count,0,RitMax,1,5)
' prima riga
ReDim aV(coll.count,2)
For Each clsP In coll
x = x + 1
aV(x,1) = x
aV(x,2) = clsP.RitMax
Next
Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
x = 0
ReDim aV(coll.count,2)
For Each clsP In coll
x = x + 1
aV(x,1) = x
aV(x,2) = clsP.IncrRitMax
Next
Call DisegnaLineaGrafico(aV,vbRed,"IncRitMax")
' scrive grafico nell'output
Call InserisciGrafico
End Sub
Function GetStringaRuote (aRuoteSel )
Dim k
Dim s
For k = 1 To 12
If aRuoteSel(k) Then
s = s & SiglaRuota(k) & " "
End If
Next
GetStringaRuote = s
End Function
Function ScegliRuotaEx (aRuoteSel)
Dim k
If MsgBox ("Vuoi elaborare su piu ruote ?" , vbQuestion + vbYesNo ) = vbYes Then
ReDim aV(10)
ReDim aVociSel(10)
For k = 1 To 10
aV(k-1) = NomeRuota(k)
Next
aV(10) = "Nazionale"
Call ScegliDaLista(aV , aVociSel, "Selezione ruote")
For k = 0 To 9
aRuoteSel(k+1) = aVociSel(k)
Next
aRuoteSel(12) = aVociSel(10)
ScegliRuotaEx = 13
Else
ReDim aV(12)
For k = 1 To 12
aV(k) = NomeRuota(k)
Next
ScegliRuotaEx = ScegliOpzioneMenu(aV)
End If
End Function
e darci una speranzina in + che non superi in futuro i valori avuti nel passato e superati di volta in volta di quel tot evidenziato dallo script...
Io senza spaziometria non posso vivereee! 
Scherzo... prenditi tutto il tempo eh! 
Per quanto riguarda il possible disk full... ho controllato e sembra che io abbia ancora 3,6 gb liberi... quindi penso non sia quello il problema...
E ad esempio vedi... per E l'incmax dal 1871 non ha mai superato le 14 estrazioni... Un valore statistico in piu' sapendo che ad esempio siamo a incmax 2. Un giocatore sarebbe stato portato (errore che ho fatto in realtà piu' volte anche io 
Secondo me sarebbe un valido aiuto. Comunque ancora grazie per questo script spettacolare! Ciao Mago 
