Rilevare Incmax di 2° livello per il superenalotto

[lotto_tom75]

Questo script creato su mia richiesta mi pare dal grande luigib stesso in persona rileva l'incmax di 2° livello per una ruota scelta. E' quindi nato per il lotto.

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 Function

Qualcuno/a sarebbe in grado, a parte luigib che non vorrei disturbare... , di "adattarlo" al superenalotto?

Grazie a tutti i programmatori e le programmatrici esperti/e che raccoglieranno "la sfida..."