Novità

Senza disturbare... Luigi il mitico creatore di spaziometria

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.

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 Function

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 :rolleyes: . Grazie infinite a chi si cimenterà in questa pimpatura... o potenziamento come si suol dire :D dello script sopra riportato. Saluti a tutti/e :) :o
 
Ciao lotto_tom75,
veramente io l'ho provato e chiede se vuoi elaborare su una o più ruote...non per niente Luigi aveva previsto questa function all'interno dello script.

Codice:
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

Controlla bene, fa già quello che Tu vuoi...


Ciao
 
Ciao lotto_tom75,
veramente io l'ho provato e chiede se vuoi elaborare su una o più ruote...non per niente Luigi aveva previsto questa function all'interno dello script.

Codice:
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

Controlla bene, fa già quello che Tu vuoi...


Ciao

E' vero! :o Come non detto ;) Grazie Moro :D
 

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 29 maggio 2025
    Bari
    45
    10
    60
    68
    59
    Cagliari
    04
    31
    24
    61
    63
    Firenze
    71
    59
    65
    53
    46
    Genova
    21
    26
    50
    63
    86
    Milano
    46
    52
    45
    21
    15
    Napoli
    88
    90
    17
    46
    12
    Palermo
    31
    40
    71
    32
    12
    Roma
    86
    81
    41
    12
    19
    Torino
    75
    32
    64
    46
    04
    Venezia
    26
    65
    38
    56
    60
    Nazionale
    16
    55
    64
    57
    12
    Estrazione Simbolotto
    Milano
    45
    26
    36
    08
    22
Indietro
Alto