lotto_tom75
Advanced Premium Member
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
Ruota = ScegliRuotaEx
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
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)
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)
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)
Call Scrivi("Sulla ruota di : " & NomeRuota(Ruota))
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 ScegliRuotaEx
Dim k
ReDim aV(12)
For k = 1 To 12
aV(k) = NomeRuota(k)
Next
ScegliRuotaEx = ScegliOpzioneMenu(aV)
End FunctionQuello che analizza l'incremento max di incremento max per intenderci...
Quello che hai chiamato in script/Vari LottoTom_AnalisiIncrRitMax.ls . E' possibile riadattarlo... per il superenalotto?Io non saprei da che parte cominciare...
ma se per te è come bere un bicchier d'acqua... sul tuo... pianeta... 
sarebbe fantastico luigi 
Grazie comunque genius
Salutoni
Ultima modifica:
