lotto_tom75
Advanced Premium Member
C'è qualcuno/a in grado di trasformare questo suo script (da me richiesto tanto tempo fa al grande Luigi e in men che non si dica realizzato da quest ultimo) in questa versione "potenziata" che adesso vado a spiegare brevemente? Grazie anticipate 
Lo script sottostante rileva in modo ottimale l'incmax di secondo livello per qualsivoglia sorte e qualsivoglia lunghetta su RUOTA SINGOLA o TUTTE.
A me adesso servirebbe la sua versione "potenziata" che calcoli questo parametro (incmax) su DUE o PIU' RUOTE UNITE, comprendendo magari volendo.. anche la NAZIONALE. Io purtroppo non so da che parte rifarmi per questa implementazione
. Grazie infinite a chi si cimenterà in questa pimpatura... o potenziamento come si suol dire 
dello script sopra riportato. Saluti a tutti/e 
Lo script sottostante rileva in modo ottimale l'incmax di secondo livello per qualsivoglia sorte e qualsivoglia lunghetta su RUOTA SINGOLA o TUTTE.
Codice:
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 FunctionA me adesso servirebbe la sua versione "potenziata" che calcoli questo parametro (incmax) su DUE o PIU' RUOTE UNITE, comprendendo magari volendo.. anche la NAZIONALE. Io purtroppo non so da che parte rifarmi per questa implementazione
. Grazie infinite a chi si cimenterà in questa pimpatura... o potenziamento come si suol dire dello script sopra riportato. Saluti a tutti/e 
Grazie Moro 
