Se qualche utente.....

[Y10]

...ha lo Script per il 10 e Lotto 5min fatto da Luigib per ricerca a fasce orarie , potrebbe gentilmente postarlo , causa formattazione me lo sono perso.
Grazie anticipate.

 

[xabio]

...ha lo Script per il 10 e Lotto 5min fatto da Luigib per ricerca a fasce orarie , potrebbe gentilmente postarlo , causa formattazione me lo sono perso.
Grazie anticipate.

Ciao Y10 io ho questo di Luigi se puo' servirti .
Ciao

'script per il 10 e lotto 5 minuti
'che ricava le Combinazioni piu frequenti entro un dato range dove si possono specificare sia inizio e fine del range sia la fascia oraria da analizzare.

Option Explicit

Dim collPresenze

Class clsFormazione
	Public nPresenze
	Public sNumeri

	
End Class

Sub Main
	Dim nEstrInizio,nEstrFine
	Dim DataIni,DataFin
	Dim FasciaOrariaIni,FasciaOrariaFin
	Dim sOraIni,sOraFin
	Dim quantitaFrz
	Dim nClasse
	Dim nEstrEsam,nEstrValide,nEstrNonValide
	
	Call ImpostaArchivio10ELotto(2)
	quantitaFrz = 10
	
	
	If ChiediDataInizioFine(DataIni,DataFin,10) Then
		If ChiediFasciaInizioFine(FasciaOrariaIni,FasciaOrariaFin,sOraIni,sOraFin) Then
			If ChiediClasse(nClasse) Then
				nEstrInizio = DataEstrToIdEstrDL(Day(DataIni),Month(DataIni),Year(DataIni),1)
				nEstrFine = DataEstrToIdEstrDL(Day(DataFin),Month(DataFin),Year(DataFin),1)
				If IsRangeValido(nEstrInizio,nEstrFine) Then
					Call EseguiStatistica(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,nClasse,nEstrEsam,nEstrValide,nEstrNonValide)
					Call ScriviParametriRicerca(DataIni,DataFin,sOraIni,sOraFin,nEstrEsam,nEstrValide,nEstrNonValide,quantitaFrz,nClasse)
					Call MostraFormazioniPiuFre(quantitaFrz)
					
				End If
			End If
		End If
	End If
End Sub
Sub ScriviParametriRicerca(DataI,DataF,OraI,OraF,EstrEsam,Valide,NonValide,QuantitaFrz,nClasse)

	Call Scrivi("Statistica delle prime " & QuantitaFrz & " formazioni piu frequenti in " & NomeSorte(nClasse))
	Call Scrivi
	Call Scrivi("Data inizio           : " & DataI)
	Call Scrivi("Data fine             : " & DataF)
	Call Scrivi("Range Orario          : " & OraI & "/" & OraF)
	Call Scrivi("Estrazioni  nel range : " & EstrEsam & " (Valide : " & Valide & "; NonValide : " & NonValide & ")")
	Call Scrivi
	
	
	
End Sub
Sub MostraFormazioniPiuFre(Quantita)

	Dim clsFrz
	Dim k,y
	Dim idFrz
	ReDim aIdFrzScelte(Quantita,1)
	
	For Each clsFrz In collPresenze
		idFrz = idFrz + 1
		For k = 1 To Quantita
			If clsFrz.nPresenze >= aIdFrzScelte(k,0) Then
				For y = Quantita To(k + 1) Step - 1
					aIdFrzScelte(y,0) = aIdFrzScelte(y - 1,0)
					aIdFrzScelte(y,1) = aIdFrzScelte(y - 1,1)
				Next
				aIdFrzScelte(k,0) = clsFrz.nPresenze
				aIdFrzScelte(k,1) = idFrz
				Exit For
			End If
		Next
	Next
	
	ReDim aV(2)
	aV(1) = "Formazione"
	aV(2) = "Presenze"
	
	InitTabella(aV)
	For k = 1 To Quantita
		Set clsFrz = collPresenze(aIdFrzScelte(k,1))
		aV(1) = clsFrz.sNumeri
		aV(2) = clsFrz.nPresenze
		Call AddRigaTabella(aV)
	Next
	
	Call CreaTabella
	
	
End Sub

Sub EseguiStatistica(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,nClasse,nEstrEsaminateTot,nEstrValide,nEstrNonValide)

	Dim k,f,idEstr
	
	
	nEstrEsaminateTot = 0
	nEstrValide = 0
	nEstrNonValide = 0
	
	
	
	Set collPresenze = GetNewCollection
	For k = nEstrInizio To nEstrFine Step 228
		Call Messaggio("Estrazione : " & k)
		For f = FasciaOrariaIni To FasciaOrariaFin
			idEstr =(k - 1) + f
			ReDim aNum(0)
			Call GetEstrazioneCompletaDL(idEstr,aNum)
			If aNum(1) > 0 Then
				Call InserisciForrmazioniInColl(aNum,nClasse)
				nEstrValide = nEstrValide + 1
			Else
				nEstrNonValide = nEstrNonValide + 1
			End If
			nEstrEsaminateTot = nEstrEsaminateTot + 1
			If ScriptInterrotto Then Exit For

		Next
		If ScriptInterrotto Then Exit For
	
	Next
End Sub
Sub InserisciForrmazioniInColl(aNumeri,nClasse)
	Dim k,sKey
	Dim nColonneTot
	Dim aCol
	Dim clsFrz
	Dim sColonna
	
	'inizializza lo sviluppo
	nColonneTot = InitSviluppoIntegrale(aNumeri,nClasse)
	k = 0
	
	' ciclo che continua fino a quando le colonne non finiscono
	Do While GetCombSviluppo(aCol)
		
		k = k + 1 ' conteggio colonna corrente
		
		' costruisco la stringa che contiene la colonna
		sColonna = StringaNumeri(aCol)
		sKey = "K" & sColonna
		
		If GetItemInColl(sKey,clsFrz) Then
			clsFrz.nPresenze = clsFrz.nPresenze + 1
		Else
			Set clsFrz = New clsFormazione
			clsFrz.sNumeri = sColonna
			clsFrz.nPresenze = 1
			
			Call collPresenze.Add(clsFrz,sKey)
		End If
		
		If k Mod 100 = 0 Then
			DoEventsEx
			Call AvanzamentoElab(0,nColonneTot,k)
			If ScriptInterrotto Then Exit Do
		End If
	Loop
	Call AvanzamentoElab(0,nColonneTot,k)

End Sub
Function GetItemInColl(sKey,cls)
	On Error Resume Next
	
	Set cls = collPresenze(sKey)
	
	If Err.number <> 0 Then
		Set cls = Nothing
		GetItemInColl = False
	Else
		GetItemInColl = True
	
	End If
	
End Function
Function IsRangeValido(Inizio,Fine)
	Dim b
	b = False
	If Inizio > 0 And Fine > 0 Then
		If Fine >= Inizio Then
			b = True
		End If
	End If
	If Not b Then
	
		MsgBox "Range non valido , probabilemente mancano le estrazioni nella base dati " & _
		vbCrLf & "EstrazioneIni : " & Inizio & vbCrLf & "EstrazioneFine  : " & Fine

			
	End If
	IsRangeValido = b
End Function
Function ChiediDataInizioFine(DataI,DataF,GiorniDaAnalizzare)
	If Not IsDate(DataF) Then DataF = FormattaStringa(Now,"dd/mm/yyyy")
	If Not IsDate(DataI) Then DataI = FormattaStringa(DateAdd("d",-(GiorniDaAnalizzare),DataF),"dd/mm/yyyy")
	DataI = InputBox("Inserire data inizio ricerca in formato GG/MM/AAAA","Data inizio",DataI)
	DataF = InputBox("Inserire data fine ricerca in formato GG/MM/AAAA","Data fine",DataF)
	If IsDate(DataI) And IsDate(DataF) Then
		
		If DateDiff("d",DataI,DataF) >= 0 Then
			ChiediDataInizioFine = True
		Else
			MsgBox "La data FINE deve essere maggiore od uguale alla data INIZIO"
		End If
	Else
		MsgBox "Date inserite non valide"
	End If
End Function
Function ChiediFasciaInizioFine(FasciaI,FasciaF,sOraIni,sOraFin)
	
	FasciaI = ChiediFasciaOraria("Fascia oraria inizio",sOraIni)
	FasciaF = ChiediFasciaOraria("Fascia oraria fine",sOraFin)
	
	If FasciaI > 0 And FasciaF > 0 Then
		If FasciaF >= FasciaI Then
		
			ChiediFasciaInizioFine = True
		Else
			MsgBox "La fascia oraria Fine deve essere maggiore della fascia oraria INIZIO"
		End If
	Else
		MsgBox "Fascie orarie non valide"
	End If
End Function

Function ChiediFasciaOraria(sCaption,sRetOra)
	Dim aLista(228)
	Dim h,m
	Dim i
	For h = 5 To 23
		For m = 5 To 60 Step 5
			i = i + 1
			If m = 60 Then
				aLista(i) = Format2(h + 1) & ":00"
			Else
				aLista(i) = Format2(h) & ":" & Format2(m)
			End If
		Next
	Next
	aLista(i) = "23:59"
	i = ScegliOpzioneMenu(aLista,- 1,sCaption)
	sRetOra = aLista(i)
	ChiediFasciaOraria = i
End Function

Function ChiediClasse(nClasse)
	
	
	ReDim aVoci(3)
	aVoci(1) = "Estratto"
	aVoci(2) = "Ambo"
	aVoci(3) = "Terno"
	
	nClasse = ScegliOpzioneMenu(aVoci,- 1,"Classe formazione")
	If nClasse > 0 Then
		ChiediClasse = True
	Else
		MsgBox "Classe formazione non valida"
	End If
End Function

 

[Y10]

Grazie Xabio è proprio quello che cercavo.
Buona giornata.