Novità

10eLotto 5 minuti

stupl

stupl

Super member
Salve a tutti, volevo chiedervi se è già stato creato uno script in che verifichi i terni più frequenti partendo dalla prima estrazione del giorno precedente fino a quella in corso, o al massimo conteggiandoli nei limiti delle 24 ore ciclico ovviamente sempre fino all'ultima in corso, visualizzando il n° di volte che sono usciti, e con data, ora e n° dell'estrazione.

Ciao e Grazie mille
:o
 
Ciao, ho trovato questo che + o - si avvicina a ciò che volevo:
Class clsPresenze
Dim Presenze
Dim sNumeri
Dim Rit
Dim RitMax
End Class

Sub Main
Dim sFile
Dim idEstr
Dim sRecord
Dim nClasse
Dim k
Dim sKey
Dim clsPres
Dim collPres
Dim nTrovati
Dim aColonne
Dim aNumeri

nClasse = ScegliClasse
If nClasse <= 0 Then Exit Sub

sFile = GetDirectoryAppData & "Estrazioni10ELotto.txt"
Call EliminaFile(sFile)

Call Messaggio("Calcolo frequenza")
Set collPres = GetNewCollection
For idEstr = EstrazioneIni To EstrazioneFin

ReDim aColonna(0)
If GetColonna(idEstr,aColonna) Then

sRecord = FormatSpace(IndiceAnnuale(idEstr),5,True) & "|" & DataEstrazione(idEstr) & "|" & StringaNumeri(aColonna,"|")
Call ScriviFile(sFile,sRecord)

aColonne = SviluppoIntegrale(aColonna,nClasse)

For k = 1 To UBound(aColonne)
sKey = "k"
For j = 1 To nClasse
sKey = sKey & Format2(aColonne(k,j)) & "."
Next
If sKey <> "" Then
sKey = Left(sKey,Len(sKey) - 1)
Set clsPres = GetClsPres(sKey,collPres)
clsPres.Presenze = clsPres.Presenze + 1
End If
Next
End If

Call AvanzamentoElab(EstrazioneIni,EstrazioneFin,idEstr)
If ScriptInterrotto Then Exit For
Next

ReDim aComb(100,2)
Call IsolaPiuFrequenti(collPres,aComb)

If ApriBaseDatiFT(sFile,20,"|") Then
Call Messaggio("Creo lista")

Call Scrivi("Elenco delle 100 combinazioni da " & nClasse & " numeri piu frequenti al 10 e lotto")
Call Scrivi

ReDim aTitoli(4)
aTitoli(1) = "Combinazione"
aTitoli(2) = "Frequenza"
aTitoli(3) = "Ritardo"
aTitoli(4) = "RitardoMax"

Call InitTabella(aTitoli)
k = 0
For k = 1 To UBound(aComb)

aNumeri = Split(aComb(k,2),".")

ReDim aV(4)
aV(1) = aComb(k,2)
aV(2) = aComb(k,1)
aV(3) = RitardoCombinazioneFT(aNumeri,nClasse)
aV(4) = SerieStoricoFT(1,EstrazioniArchivioFT,aNumeri,nClasse)

If aComb(k,1) > 0 Then

Call AddRigaTabella(aV)
End If
Call AvanzamentoElab(1,UBound(aComb),k)
If ScriptInterrotto Then Exit For

Next

Call CreaTabella(2,0,0,100)
Else
MsgBox "File estrazioni 10 e lotto non prodotto"
End If

End Sub

Function GetClsPres(sKey,collPres)
On Error Resume Next
Dim clsP

Set clsP = collPres(sKey)
If clsP Is Nothing Then
Set clsP = New clsPresenze
clsP.sNumeri = Mid(sKey,2)
clsP.Presenze = 0

collPres.Add clsP,sKey
End If

Set GetClsPres = clsP

End Function

Function GetColonna(idEstrazione,colonna)

Dim nInseriti
Dim Ruota,pos,n
Dim k,i
ReDim aCol(90)
ReDim colonna(20)
Do While nInseriti < 20 And pos <= 5
For pos = 1 To 5
For Ruota = 1 To 10
n = Estratto(idEstrazione,Ruota,pos)
If n > 0 Then
If aCol(n) = False Then
aCol(n) = True
nInseriti = nInseriti + 1

If nInseriti = 20 Then Exit For
End If
End If
Next
If nInseriti = 20 Then Exit For

Next
Loop

For k = 1 To 90
If aCol(k) Then
i = i + 1
colonna(i) = k
End If
Next

ReDim Preserve colonna(i)

If i = 20 Then
GetColonna = True
Else
GetColonna = False
End If
End Function

Function ScegliClasse()
ReDim aVoci(3)

aVoci(0) = "Estratto"
aVoci(1) = "Ambo"
aVoci(2) = "Terno"
aVoci(3) = "Quaterna"

ScegliClasse = ScegliOpzioneMenu(aVoci,2,"Secegli tipo combinazione") + 1
End Function

Sub IsolaPiuFrequenti(collPres,aComb)
Dim k,j,i
Dim clsPres

Call Messaggio("Selezione combinazioni piu frequenti")
ReDim aComb(100,2)
For k = 1 To UBound(aComb)
aComb(k,1) = 0
aComb(k,2) = ""
Next

i = 0
For Each clsPres In collPres

For k = 1 To UBound(aComb)
If clsPres.presenze >= aComb(k,1) Then

For j = UBound(aComb) To(k + 1) Step - 1

aComb(j,1) = aComb(j - 1,1)
aComb(j,2) = aComb(j - 1,2)

Next
aComb(k,1) = clsPres.presenze
aComb(k,2) = clsPres.snumeri
Exit For
End If

Next
i = i + 1
Call AvanzamentoElab(1,collPres.count,i)
If ScriptInterrotto Then Exit For

Next
End Sub
Clicca per espandere...

Lo lancio, e selezionando una qualsiasi frequenza che mi chiede, dall'estratto alla quaterna, alla fine dell'esecuzione mi da l'errore 55-File already open.
Come mai?
 
prova così
Codice: 
Class clsPresenze
Dim Presenze
Dim sNumeri
Dim Rit
Dim RitMax
End Class

Sub Main
Dim sFile
Dim idEstr
Dim sRecord
Dim nClasse
Dim k
Dim sKey
Dim clsPres
Dim collPres
Dim nTrovati
Dim aColonne
Dim aNumeri

nClasse = ScegliClasse
If nClasse <= 0 Then Exit Sub

sFile = GetDirectoryAppData & "Estrazioni10ELotto.txt"
Call EliminaFile(sFile)

Call Messaggio("Calcolo frequenza")
Set collPres = GetNewCollection
For idEstr = EstrazioneIni To EstrazioneFin

ReDim aColonna(0)
If GetColonna(idEstr,aColonna) Then

sRecord = FormatSpace(IndiceAnnuale(idEstr),5,True) & "|" & DataEstrazione(idEstr) & "|" & StringaNumeri(aColonna,"|")
Call ScriviFile(sFile,sRecord)

aColonne = SviluppoIntegrale(aColonna,nClasse)

For k = 1 To UBound(aColonne)
sKey = "k"
For j = 1 To nClasse
sKey = sKey & Format2(aColonne(k,j)) & "."
Next
If sKey <> "" Then
sKey = Left(sKey,Len(sKey) - 1)
Set clsPres = GetClsPres(sKey,collPres)
clsPres.Presenze = clsPres.Presenze + 1
End If 
Next
End If

Call AvanzamentoElab(EstrazioneIni,EstrazioneFin,idEstr )
If ScriptInterrotto Then Exit For
Next

ReDim aComb(100,2)
Call IsolaPiuFrequenti(collPres,aComb)

If ApriBaseDatiFT(sFile,20,"|") Then
Call Messaggio("Creo lista")

Call Scrivi("Elenco delle 100 combinazioni da " & nClasse & " numeri piu frequenti al 10 e lotto")
Call Scrivi

ReDim aTitoli(4)
aTitoli(1) = "Combinazione"
aTitoli(2) = "Frequenza"
aTitoli(3) = "Ritardo"
aTitoli(4) = "RitardoMax"

Call InitTabella(aTitoli)
k = 0
For k = 1 To UBound(aComb)

aNumeri = Split(aComb(k,2),".")

ReDim aV(4)
aV(1) = aComb(k,2)
aV(2) = aComb(k,1)
aV(3) = RitardoCombinazioneFT(aNumeri,nClasse)
aV(4) = SerieStoricoFT(1,EstrazioniArchivioFT,aNumeri,nClasse)

If aComb(k,1) > 0 Then

Call AddRigaTabella(aV)
End If
Call AvanzamentoElab(1,UBound(aComb),k)
If ScriptInterrotto Then Exit For

Next

Call CreaTabella(2,0,0,100)
Else
MsgBox "File estrazioni 10 e lotto non prodotto"
End If

End Sub

Function GetClsPres(sKey,collPres)
On Error Resume Next
Dim clsP

Set clsP = collPres(sKey)
If clsP Is Nothing Then
Set clsP = New clsPresenze
clsP.sNumeri = Mid(sKey,2)
clsP.Presenze = 0

collPres.Add clsP,sKey
End If

Set GetClsPres = clsP

End Function

Function GetColonna(idEstrazione,colonna)

Dim nInseriti
Dim Ruota,pos,n
Dim k,i
ReDim aCol(90)
ReDim colonna(20)
Do While nInseriti < 20 And pos <= 5
For pos = 1 To 5
For Ruota = 1 To 10
n = Estratto(idEstrazione,Ruota,pos)
If n > 0 Then
If aCol(n) = False Then
aCol(n) = True
nInseriti = nInseriti + 1

If nInseriti = 20 Then Exit For
End If
End If 
Next
If nInseriti = 20 Then Exit For

Next
Loop

For k = 1 To 90
If aCol(k) Then
i = i + 1
colonna(i) = k
End If
Next

ReDim Preserve colonna(i)

If i = 20 Then
GetColonna = True
Else
GetColonna = False
End If
End Function

Function ScegliClasse()
ReDim aVoci(3)

aVoci(0) = "Estratto"
aVoci(1) = "Ambo"
aVoci(2) = "Terno"
aVoci(3) = "Quaterna"

ScegliClasse = ScegliOpzioneMenu(aVoci,2,"Secegli tipo combinazione") + 1
End Function

Sub IsolaPiuFrequenti(collPres,aComb)
Dim k,j,i
Dim clsPres

Call Messaggio("Selezione combinazioni piu frequenti")
ReDim aComb(100,2)
For k = 1 To UBound(aComb)
aComb(k,1) = 0
aComb(k,2) = ""
Next

i = 0	
For Each clsPres In collPres

For k = 1 To UBound(aComb)
If clsPres.presenze >= aComb(k,1) Then

For j = UBound(aComb) To(k + 1) Step - 1

aComb(j,1) = aComb(j - 1,1)
aComb(j,2) = aComb(j - 1,2)

Next
aComb(k,1) = clsPres.presenze
aComb(k,2) = clsPres.snumeri
Exit For
End If

Next
i = i + 1
Call AvanzamentoElab(1,collPres.count,i)
If ScriptInterrotto Then Exit For

Next
End Sub
 
ma questo è per il 10elotto serale e poi non apre o legge un file estrazionelotto.txt presente nella directory dati di spaziometria almeno credo
 
prova questo è stato realizzato da luigib
Codice: 
Option Explicit
Dim collFormazioni
Dim CollFomGiocateFreq
Dim CollFomGiocateNonFreq
Dim aColonneDL
Dim aMatriceRid
Dim aPremi
Dim aPoste
Class clsFormazione
	Public nPresenze
	Public sNumeri
	Public aNumeri(10)
End Class
Sub Main
	Dim nEstrInizio,nEstrFine
	Dim DataIni,DataFin
	Dim FasciaOrariaIni,FasciaOrariaFin
	Dim sOraIni,sOraFin
	Dim quantitaFrz
	Dim nClasse,nSorte
	Dim nEstrEsam,nEstrValide,nEstrNonValide
	Dim bUsaRidotto
	Dim sFileSistema
	Call ImpostaArchivio10ELotto(2)
	Call ImpostaPremi
	quantitaFrz = Int(InputBox("Quantita formazioni in gioco","Quantita",2))
	If quantitaFrz > 0 Then
		If ChiediDataInizioFine(DataIni,DataFin,10) Then
			If ChiediFasciaInizioFine(FasciaOrariaIni,FasciaOrariaFin,sOraIni,sOraFin) Then
				If ChiediClasse(nClasse) Then
					If ChiediSorte(nSorte) Then
						If ChiediTipoSviluppo(bUsaRidotto,sFileSistema,nClasse,nSorte) 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,nSorte,bUsaRidotto,nEstrEsam,nEstrValide,nEstrNonValide)
								Call ScriviParametriRicerca(DataIni,DataFin,sOraIni,sOraFin,nEstrEsam,nEstrValide,nEstrNonValide,quantitaFrz,nClasse,nSorte)
								Call MostraFormazioniPiuFre(quantitaFrz)
								Call MostraFormazioniMenoFre(quantitaFrz)
								Call InitAnalizzaGioco(DataFin,FasciaOrariaIni,FasciaOrariaFin,nClasse,nSorte)
							End If
						End If
					End If
				End If
			End If
		End If
	End If
End Sub
Sub ScriviParametriRicerca(DataI,DataF,OraI,OraF,EstrEsam,Valide,NonValide,QuantitaFrz,nClasse,nSorte)
	Call Scrivi("Statistica delle prime " & QuantitaFrz & " formazioni piu frequenti in " & NomeSorte(nClasse) & " per la sorte di " & NomeSorte(nSorte))
	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
	Call Scrivi("Formazioni piu frequenti")
	ReDim aIdFrzScelte(Quantita,1)
	For Each clsFrz In collFormazioni
		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 = collFormazioni(aIdFrzScelte(k,1))
		aV(1) = clsFrz.sNumeri
		aV(2) = clsFrz.nPresenze
		Call AddRigaTabella(aV)
		Call CollFomGiocateFreq.Add(clsFrz)
	Next
	Call CreaTabella
End Sub
Sub MostraFormazioniMenoFre(Quantita)
	Dim clsFrz
	Dim k,y
	Dim idFrz
	Call Scrivi("Formazioni meno frequenti (tra quelle comunque uscite)")
	ReDim aIdFrzScelte(Quantita,1)
	For k = 1 To Quantita
		aIdFrzScelte(k,0) = 10000000
	Next
	For Each clsFrz In collFormazioni
		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 = collFormazioni(aIdFrzScelte(k,1))
		aV(1) = clsFrz.sNumeri
		aV(2) = clsFrz.nPresenze
		Call AddRigaTabella(aV)
		Call CollFomGiocateNonFreq.Add(clsFrz)
	Next
	Call CreaTabella
End Sub
Sub EseguiStatistica(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,nClasse,nSorte,bUsaRidotto,nEstrEsaminateTot,nEstrValide,nEstrNonValide)
	Dim k,f,idEstr,idCol,y,p
	Dim idFrz
	Dim clsFrz
	nEstrEsaminateTot = 0
	nEstrValide = 0
	nEstrNonValide = 0
	idFrz = 0
	idCol = 0
	ReDim aColonneDL(GetQColonneInteressate(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin),90)
	Set collFormazioni = GetNewCollection
	Set CollFomGiocateFreq = GetNewCollection
	Set CollFomGiocateNonFreq = 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
				idCol = idCol + 1
				For y = 1 To 20
					aColonneDL(idCol,aNum(y)) = True
				Next
				Call InserisciForrmazioniInColl(aNum,nClasse,nSorte,bUsaRidotto)
				nEstrValide = nEstrValide + 1
			Else
				nEstrNonValide = nEstrNonValide + 1
			End If
			nEstrEsaminateTot = nEstrEsaminateTot + 1
			If ScriptInterrotto Then Exit For
		Next
		If ScriptInterrotto Then Exit For
	Next
	Messaggio("Conteggio formazioni piu frequenti")
	Call AvanzamentoElab(0,collFormazioni.count,idFrz)
	For Each clsFrz In collFormazioni
		For k = 1 To UBound(aColonneDL)
			p = 0
			For y = 1 To nClasse
				If aColonneDL(k,clsFrz.aNumeri(y)) Then
					p = p + 1
				End If
			Next
			If p >= nSorte Then
				clsFrz.nPresenze = clsFrz.nPresenze + 1
			End If
		Next
		idFrz = idFrz + 1
		If idFrz Mod 100 = 0 Then
			Call AvanzamentoElab(0,collFormazioni.count,idFrz)
			If ScriptInterrotto Then Exit For
		End If
	Next
	Call AvanzamentoElab(0,collFormazioni.count,idFrz)
End Sub
Function GetQColonneInteressate(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin)
	Dim nGg
	nGg =(((nEstrFine + 1) - nEstrInizio)\228) + 1
	If nGg = 0 Then nGg = 1
	GetQColonneInteressate =((FasciaOrariaFin + 1) - FasciaOrariaIni) * nGg
End Function
Sub InserisciForrmazioniInColl(aNumeri,nClasse,nSorte,bUsaRidotto)
	If bUsaRidotto Then
		Call InserisciForrmazioniInCollRidotto(aNumeri,nClasse)
	Else
		Call InserisciForrmazioniInCollIntegrale(aNumeri,nClasse)
	End If
End Sub
Sub InserisciForrmazioniInCollRidotto(aNumeri,nClasse)
	Dim idCol,y,j
	ReDim aCol(nClasse)
	Dim sColonna,sKey
	Dim clsFrz
	Dim nTmp
	For j = 1 To 19
		For idCol = 1 To UBound(aMatriceRid)
			Set clsFrz = New clsFormazione
			For y = 1 To nClasse
				aCol(y) = aNumeri(aMatriceRid(idCol,y))
				clsFrz.aNumeri(y) = aCol(y)
			Next
			Call OrdinaMatrice(aCol,1)
			sColonna = StringaNumeri(aCol)
			clsFrz.sNumeri = sColonna
			sKey = "K" & sColonna
			Call AddItemInColl(collFormazioni,clsFrz,sKey)
			If idCol Mod 10 = 0 Then
				DoEventsEx
				Call AvanzamentoElab(0,UBound(aMatriceRid),idCol)
				If ScriptInterrotto Then Exit For
			End If
		Next
		nTmp = aNumeri(UBound(aNumeri))
		For y = UBound(aNumeri) To 2 Step - 1
			aNumeri(y) = aNumeri(y - 1)
		Next
		aNumeri(1) = nTmp
	Next
End Sub
Sub InserisciForrmazioniInCollIntegrale(aNumeri,nClasse)
	Dim k,sKey,y
	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
		Set clsFrz = New clsFormazione
		sColonna = ""
		For y = 1 To nClasse
			clsFrz.aNumeri(y) = aCol(y)
			sColonna = sColonna & aCol(y) & "."
		Next
		sColonna = Left(sColonna,Len(sColonna) - 1)
		clsFrz.sNumeri = sColonna
		sKey = "K" & sColonna
		Call AddItemInColl(collFormazioni,clsFrz,sKey)
		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
Sub AddItemInColl(collX,Itm,sKey)
	On Error Resume Next
	Call collX.Add(Itm,sKey)
End Sub
Function GetItemInColl(sKey,cls,collX)
	On Error Resume Next
	Set cls = collX(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)
	Dim k
	ReDim aVoci(6)
	For k = 1 To 6
		aVoci(k) = k
	Next
	nClasse = ScegliOpzioneMenu(aVoci,- 1,"Classe formazione")
	If nClasse > 0 Then
		ChiediClasse = True
	Else
		MsgBox "Classe formazione non valida"
	End If
End Function
Function ChiediSorte(nClasse)
	ReDim aVoci(3)
	aVoci(1) = "Estratto"
	aVoci(2) = "Ambo"
	aVoci(3) = "Terno"
	nClasse = ScegliOpzioneMenu(aVoci,- 1,"Sorte cercata")
	If nClasse > 0 Then
		ChiediSorte = True
	Else
		MsgBox "Classe formazione non valida"
	End If
End Function
Function ChiediTipoSviluppo(bUsaRidotto,sFileSistema,nClasse,nSorte)
	Dim i
	ReDim aVoci(2)
	aVoci(1) = "Integrale (molto lento)"
	aVoci(2) = "Ridotto (piu veloce)"
	sFileSistema = GetDirectoryAppData & "sistemi\" & "20" & "_" & nClasse & "_" & nSorte & ".dat"
	i = ScegliOpzioneMenu(aVoci,2,"Tipo sviluppo")
	If i > 0 Then
		If i = 2 Then
			bUsaRidotto = True
		Else
			bUsaRidotto = False
			MsgBox "Attenzione non usando il metodo ridotto oltre ad essere piu lento potrebbe capitare " & _
			"un errore a causa di problemi di memoria insufficiente",vbInformation
		End If
		If bUsaRidotto Then
			'If FileEsistente(sFileSistema) Then
			ReDim aMatriceRid(0)
			If GetMatriceSistemaRidotto(sFileSistema,aMatriceRid,0,0,0,0) Then
				ChiediTipoSviluppo = True
			Else
				MsgBox "Avendo scelto lo sviuluppo ridotto è " & _
				"necessaria la presenza della matrice nella cartella dei sistemi" & vbCrLf & sFileSistema
			End If
			'Else
			'	MsgBox "Avendo scelto lo sviuluppo ridotto è " & _
			'	"necessaria la presenza della matrice nella cartella dei sistemi" & vbCrLf & sFileSistema
			'End If
		Else
			ChiediTipoSviluppo = True
		End If
	Else
		MsgBox "Tipo sviluppo non valido"
	End If
End Function
Sub InitAnalizzaGioco(Data,FasciaOrariaIni,FasciaOrariaFin,nClasse,nSorte)
	Dim DataIni,DataFin,nEstrInizio,nEstrFine,ColMax
	DataIni = FormattaStringa(DateAdd("d",1,Data),"dd/mm/yyyy")
	DataFin = DataIni
	nEstrInizio = DataEstrToIdEstrDL(Day(DataIni),Month(DataIni),Year(DataIni),1)
	nEstrFine = DataEstrToIdEstrDL(Day(DataFin),Month(DataFin),Year(DataFin),1)
	If nEstrInizio > 0 And nEstrFine > 0 Then
		'If MsgBox("Desideri analizzare un ipotesi di gioco sulle estrazioni successive a quelle analizzate (un'ora di gioco il giorno successivo)",vbQuestion + vbYesNo) = vbYes Then
		Scrivi "Simulazione di gioco nella data di " & DataIni
		Call ImpostaPoste(nClasse,nSorte)
		Call LeggiEstrazioniTestGiocata(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,ColMax)
		Call AnalisiGioco(ColMax,nClasse,nSorte,CollFomGiocateFreq,"Simulazione giocando le formazioni frequenti (un'ora di gioco)")
		Call AnalisiGioco(ColMax,nClasse,nSorte,CollFomGiocateNonFreq,"Simulazione giocando le formazioni meno frequenti (un'ora di gioco)")
		'End If
	End If
End Sub
Sub LeggiEstrazioniTestGiocata(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,RetCol)
	Dim k,y,f,idEstr,idCol,nEstrEsaminateTot
	idCol = 0
	ReDim aColonneDL(GetQColonneInteressate(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin),90)
	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
				idCol = idCol + 1
				For y = 1 To 20
					aColonneDL(idCol,aNum(y)) = True
				Next
			End If
			nEstrEsaminateTot = nEstrEsaminateTot + 1
		Next
	Next
	RetCol = idCol
End Sub
Sub AnalisiGioco(MaxCol,nClasse,nSorte,collFrz,sTesto)
	Dim clsF
	Dim idCol
	Dim p,k
	Dim nVincita,nSpesa
	Call Scrivi(sTesto)
	ReDim aPuntiTot(nClasse)
	For k = 1 To nClasse
		aPuntiTot(k) = 0
	Next
	nVincita = 0
	nSpesa = 0
	For idCol = 1 To MaxCol
		If idCol <= UBound(aPoste) Then
			For Each clsF In collFrz
				p = 0
				For k = 1 To nClasse
					If aColonneDL(idCol,clsF.aNumeri(k))Then
						p = p + 1
					End If
				Next
				aPuntiTot(p) = aPuntiTot(p) + 1
				nSpesa = nSpesa + aPoste(idCol)
				nVincita = nVincita +(aPremi(nClasse,p) * aPoste(idCol))
			Next
		End If
	Next
	Call Scrivi("Punteggio conseguito")
	For k = 1 To nClasse
		If aPremi(nClasse,k) > 0 Then
			Call Scrivi("Punti : " & k & " --> " & aPuntiTot(k))
		End If
	Next
	Call Scrivi("Spesa    : " & nSpesa)
	Call Scrivi("Vincita  : " & nVincita)
	Call Scrivi("Guadagno : " & nVincita - nSpesa)
	Call Scrivi
End Sub
Sub ImpostaPremi
	ReDim aPremi(10,10)
	Dim k,kk
	For k = 0 To 10
		For kk = 0 To 10
			aPremi(k,kk) = 0
		Next
	Next
	aPremi(1,1) = 3 ' giocato 1 vinto 1
	'-----------------------------------
	aPremi(2,1) = 1 ' giocato 2 vinto 1
	aPremi(2,2) = 7 ' giocato 2 vinto 2
	'-----------------------------------
	aPremi(3,2) = 2 ' giocato 3 vinto 2
	aPremi(3,3) = 50 ' giocato 3 vinto 3
	'-----------------------------------
	aPremi(4,2) = 1 ' giocato 4 vinto 2
	aPremi(4,3) = 10 ' giocato 4 vinto 3
	aPremi(4,4) = 100 ' giocato 4 vinto 4
	'-----------------------------------
	aPremi(5,2) = 1 ' giocato 5 vinto 2
	aPremi(5,3) = 4 ' giocato 5 vinto 3
	aPremi(5,4) = 15 ' giocato 5 vinto 4
	aPremi(5,5) = 200 ' giocato 5 vinto 5
	'-----------------------------------
	aPremi(6,3) = 2 ' giocato 6 vinto 3
	aPremi(6,4) = 10 ' giocato 6 vinto 4
	aPremi(6,5) = 100 ' giocato 6 vinto 5
	aPremi(6,6) = 2000 ' giocato 6 vinto 6
	'-----------------------------------
	aPremi(7,4) = 4 ' giocato 7 vinto 4
	aPremi(7,5) = 40 ' giocato 7 vinto 5
	aPremi(7,6) = 400 ' giocato 7 vinto 6
	aPremi(7,7) = 4000 ' giocato 7 vinto 7
	'-----------------------------------
	aPremi(8,5) = 20 ' giocato 8 vinto 5
	aPremi(8,6) = 200 ' giocato 8 vinto 6
	aPremi(8,7) = 1000 ' giocato 8 vinto 7
	aPremi(8,8) = 20000 ' giocato 8 vinto 8
	'-----------------------------------
	aPremi(9,5) = 10 ' giocato 9 vinto 5
	aPremi(9,6) = 40 ' giocato 9 vinto 6
	aPremi(9,7) = 400 ' giocato 9 vinto 7
	aPremi(9,8) = 4000 ' giocato 9 vinto 8
	aPremi(9,9) = 100000 ' giocato 9 vinto 9
	'-----------------------------------
	aPremi(10,5) = 5 ' giocato 10 vinto 5
	aPremi(10,6) = 15 ' giocato 10 vinto 6
	aPremi(10,7) = 150 ' giocato 10 vinto 7
	aPremi(10,8) = 1500 ' giocato 10 vinto 8
	aPremi(10,9) = 30000 ' giocato 10 vinto 9
	aPremi(10,10) = 1000000 ' giocato 10 vinto 10
End Sub
Sub ImpostaPoste(nClasse,nSorte)
	Dim k
	Dim QuantitaGiocate
	QuantitaGiocate = 12 ' un 'ora di gico
	ReDim aPoste(QuantitaGiocate)
	' modificare i valori per la progressione nei 12 colpi e remmarre tutto il blocco select case
	aPoste(1) = 1
	aPoste(2) = 1
	aPoste(3) = 1
	aPoste(4) = 1
	aPoste(5) = 1
	aPoste(6) = 1
	aPoste(7) = 1
	aPoste(8) = 1
	aPoste(9) = 1
	aPoste(10) = 1
	aPoste(11) = 1
	aPoste(12) = 1
	Select Case nClasse
	Case 2
		If nSorte = 1 Then
			For k = 2 To 12
				aPoste(k) = aPoste(k - 1) *2
			Next
		ElseIf nSorte = 2 Then
			aPoste(8) = 2
			aPoste(9) = 2
			aPoste(10) = 3
			aPoste(11) = 3
			aPoste(12) = 4
		End If
	Case 3
		If nSorte = 2 Then
			For k = 3 To 12
				If k Mod 2 <> 0 Then
					aPoste(k) = aPoste(k - 1) *2
				Else
					aPoste(k) = aPoste(k - 1)
				End If
			Next
		End If
	Case 4
		If nSorte = 2 Then
			For k = 2 To 12
				aPoste(k) = aPoste(k - 1) *2
			Next
		ElseIf nSorte = 3 Then
			aPoste(11) = 2
			aPoste(12) = 2
		End If
	Case 5
		If nSorte = 2 Then
			For k = 2 To 12
				aPoste(k) = aPoste(k - 1) *2
			Next
		ElseIf nSorte = 3 Then
			aPoste(4) = 2
			aPoste(5) = 3
			aPoste(6) = 3
			aPoste(7) = 5
			aPoste(8) = 5
			aPoste(9) = 7
			aPoste(10) = 7
			aPoste(11) = 9
			aPoste(12) = 11
		End If
	Case 6
		If nSorte = 3 Then
			For k = 3 To 12
				If k Mod 2 <> 0 Then
					aPoste(k) = aPoste(k - 1) *2
				Else
					aPoste(k) = aPoste(k - 1)
				End If
			Next
		ElseIf nSorte = 4 Then
			aPoste(10) = 2
			aPoste(11) = 3
			aPoste(12) = 4
		End If
	End Select
End Sub
 
Il primo script che mi hai postato mi da lo stesso errore 55-file already open, il secondo va in errore sia che faccio il ridotto che l'integrale
 
ma come inserisci le date? le riscrivi poi che versione hai di spaziometria? a me funzionano tutti e due
 
Le inserisco come me le chiede gg/mm/aaaa.
Di spaziometria ho l'ultima versione la 1.4.49
 
Ultima modifica:
No è proprio un errore è che in output non visualizza nulla, anche cercando combinazioni frequenti su 2 numeri o un numero, il che è strano visto che durante le 288 estrazioni giornaliere di combinazioni frequenti c'è ne sono abbastanza da scriverne almeno qualcuna ed invece esce la schermata in bianco, questo vale sempre per il secondo script che hai postato di LuigiB mentre il primo mi da l'errore "55 - File already open"
 
^non ho ricevuto più risposta al continuo di questa discussione.
non fa niente, grazie lo stesso, ho trovato un sito che mi elenca i terni più frequenti.

Visto che mi trovo però avrei una proposta da fare in riguardo alla creazione di uno script, sempre che si possa fare, in pratica sfogliando una vecchia smorfia napoletana ho trovato un metodo piramidale, (credo tipo cabala e cose del genere), per ricavare dei numeri per il gioco del lotto che io vorrei applicare,invece, al 10eLotto serale (poi spiego come), ovviamente sempre da verificare l'efficienza.
Questo metodo per il lotto consiste nel prendere i 5 estratti dell'ultima estrazione e associarli, per poi sommarli, uno per volta alla data dell'estrazione successiva facendo una somma a piramide, esempio:
estrazione di ieri su bari è 40-24-61-65-27 ad ogni numero associo la data della prossima estrazione il 21/09/2013 quindi ne verrebbe fuori questa serie 4021092013, 2421092013 ecc. fino al 5° estratto.
iniziando dalla prima serie si somma 4 con 0, 0 con 2, 2 con 1, ecc. uscendo un altra serie che sarebbe, 423192214 (qui premetto che nel sommare 9+2=11 ci sono 2 versioni: quella che ho applicato nell'esempio sommando 1+1 quindi inserendo il 2 altrimenti applicare il -10 quindi 11-10=1 inserendo 1). Quindi ancora
65412435 e così via fino a ricavarne un numero solo, stessa cosa per gli altri estratti.

Come dicevo sopra, però, vorrei applicarlo al 10eLotto serale visto che comunque i 20 numeri estratti li prendono dalle 10 ruote del lotto. Il modo con cui vorrei applicarlo è: prendere, in ordine partendo dalla ruota di bari, i primi due numeri e associarli tra loro e con la data dell'estrazione successiva tipo:
402421092013 sommarli come ho spiegato sopra fino a ricavarne un numero, ovviamente sarebbe preferibile con entrambe le versioni di cui ho premesso, alla fine su 20 se ne ricavano 10 da giocare.
Unico intoppo è che tali numeri cambierebbero per ogni estrazione ma volendo li si può rigiocare per altre 5 volte e a questo proposito l'unica verifica che si può fare e quella di esaminare i numeri in gioco con estrazioni precedenti e successive a quella da cui si sono ricavati, così da vedere quanti punti ci si fa con tali numeri in gioco, quindi sarebbe comodo inserire nello script tale verifica.
Più o meno e questo quello che desidererei sempre che, come detto sopra, si possa fare.
Grazie mille aspetto risposta.
 
Ultima modifica:
ma ciò che cerchi potresti realizzarlo con spaziometria ricavati una file excell con tutte le terzine che sono 117480 e caricale nel programma e sei a cavallo
 
ti posto l'output del secondo script

Statistica delle prime 10 formazioni piu frequenti in Terno per la sorte di Terno

Data inizio : 15/09/2013
Data fine : 19/09/2013
Range Orario : 05:05/23:59
Estrazioni nel range : 1368 (Valide : 1367; NonValide : 1)

Formazioni piu frequenti
Formazione Presenze 4.17.81 31 1.32.48 30 13.21.46 30 81.82.90 30 9.59.63 29 15.83.90 29 48.68.81 29 43.48.85 29 8.9.71 29 25.27.84 29

Formazioni meno frequenti (tra quelle comunque uscite)
Formazione Presenze 13.37.65 1 21.41.65 1 36.37.54 2 21.27.65 2 35.44.63 2 30.49.78 2 35.63.71 2 3.35.72 2 5.36.61 2 24.37.58 2

Simulazione di gioco nella data di 20/09/2013
Simulazione giocando le formazioni frequenti (un'ora di gioco)
Punteggio conseguito
Punti : 2 --> 17
Punti : 3 --> 2
Spesa : 120
Vincita : 134
Guadagno : 14

Simulazione giocando le formazioni meno frequenti (un'ora di gioco)
Punteggio conseguito
Punti : 2 --> 14
Punti : 3 --> 0
Spesa : 120
Vincita : 28
Guadagno : -92
 
ti posto l'output del secondo script

Statistica delle prime 10 formazioni piu frequenti in Terno per la sorte di Terno

Data inizio : 15/09/2013
Data fine : 19/09/2013
Range Orario : 05:05/23:59
Estrazioni nel range : 1368 (Valide : 1367; NonValide : 1)

Formazioni piu frequenti
Formazione Presenze 4.17.81 31 1.32.48 30 13.21.46 30 81.82.90 30 9.59.63 29 15.83.90 29 48.68.81 29 43.48.85 29 8.9.71 29 25.27.84 29

Formazioni meno frequenti (tra quelle comunque uscite)
Formazione Presenze 13.37.65 1 21.41.65 1 36.37.54 2 21.27.65 2 35.44.63 2 30.49.78 2 35.63.71 2 3.35.72 2 5.36.61 2 24.37.58 2

Simulazione di gioco nella data di 20/09/2013
Simulazione giocando le formazioni frequenti (un'ora di gioco)
Punteggio conseguito
Punti : 2 --> 17
Punti : 3 --> 2
Spesa : 120
Vincita : 134
Guadagno : 14

Simulazione giocando le formazioni meno frequenti (un'ora di gioco)
Punteggio conseguito
Punti : 2 --> 14
Punti : 3 --> 0
Spesa : 120
Vincita : 28
Guadagno : -92
 
Per i terni frequenti , ripeto, ho trovato ,a parte il sito di cui ti parlavo sopra, anche in spaziometria ciò che mi interessava quindi per questo problema ho risolto quello che chiedo, sempre che sia possibile e sempre per favore, lo script che parlavo sopra.
Se è fattibile la cosa si potrebbe creare questo script vorrei provarlo perchè fare tutti i calcoli e trascriverli a mano è lunga la cosa.
Fammi sapere
Grazie
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 19 giugno 2025
    Bari
    32
    64
    67
    30
    17
    Cagliari
    39
    56
    77
    12
    35
    Firenze
    11
    16
    59
    72
    02
    Genova
    80
    79
    05
    03
    33
    Milano
    09
    87
    23
    88
    82
    Napoli
    56
    74
    85
    16
    61
    Palermo
    84
    21
    08
    18
    85
    Roma
    71
    84
    20
    54
    86
    Torino
    28
    36
    68
    49
    53
    Venezia
    14
    45
    39
    43
    42
    Nazionale
    73
    11
    46
    20
    26
    Estrazione Simbolotto
    Napoli
    43
    35
    11
    26
    40
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto