Per Keeper a Question

[keeper]

per oggi nulla?

 

[keeper]

grazie per la foto avevo problemi con l'archivio e non me ne ero mai accorto mancavano le estr. dal 25 maggio al 2 agostosto provvfedendo a rifare l'archivio

 

[Carry]

Buona sera Keeper,ieri guardando il suo post ho preso nota di alcune terzine e un paio le ho giocate stasera.Da come scrive ho notato la sua professionalita' e competenza.Io sono negata.Per farla breve,dopo 4 tentativi nulli al quinto(uscivano 2 num,o 1 solo),grazie a lei ho vinto 50 euro con 8 40 42,mi sembra estrazione 208 o 209.Certo "il lato B" fa la sua parte,ma a me piace dare a Cesare quel che e' di Cesare.Grazie ancora e complimenti,e se ha suggerimenti io la seguo.Grazie

 

[keeper]

la ringrazio sono lusingato dei complimenti ma di sicuro si tratta di lato b pensi che se le gioco io non sortiscono. il mio è solo un aiuto nello scegliere combinazioni ristrette ma non posso garantire il 100%.

 

[Carry]

Si lo so che non c'e' certezza,saremmo tutti ricchi!Se avessi scelto 2 terzine diverse da quelle che mi hanno fatto vincere,forse non avrei vinto.Ho gia' ringraziato il mio lato B,apprezzo comunque il suo aiuto.
Se fosse possibile darci del tu,altrimenti mi sembra di parlare con gli utente al lavoro Buona notte

 

[xabio]

Terzina nella fascia 8,30 / 10,30 compresi cioe' 25 est.



Non ho trovato al momento convergenza per stringere la fascia
se hai qualche idea Keeper .


Ciao

 

[keeper]

Si lo so che non c'e' certezza,saremmo tutti ricchi!Se avessi scelto 2 terzine diverse da quelle che mi hanno fatto vincere,forse non avrei vinto.Ho gia' ringraziato il mio lato B,apprezzo comunque il suo aiuto.
Se fosse possibile darci del tu,altrimenti mi sembra di parlare con gli utente al lavoro Buona notte

ma certo dammi del tu

 

[keeper]

Terzina nella fascia 8,30 / 10,30 compresi cioe' 25 est.

Vedi l'allegato 6653

Non ho trovato al momento convergenza per stringere la fascia
se hai qualche idea Keeper .


Ciao

io ho questi numeri

01.03.06.10.16.62

 

[keeper]

le ho sviluppate in questo modo

01 03 06 10
01 03 06 16
01 03 06 62
01 03 10 16
01 03 10 62
01 03 16 62
01 06 10 16
01 06 10 62
01 06 16 62
01 10 16 62
03 06 10 16
03 06 10 62
03 06 16 62
03 10 16 62
06 10 16 62

 

[keeper]

poi da un'altra ricerca su 10000 estr. per fasce orarie ho queste:

Formazione Presenze
15.53.61 13
15.61.84 12
7.44.88 12
29.44.87 12
7.20.44 12
2.49.53 11
47.53.61 11
49.88.90 11
6.23.74 11
38.44.62 11
36.84.85 11
24.53.62 11
22.53.67 11
29.44.61 11
6.21.49 11
53.61.90 11
6.8.53 11
6.63.75 11
7.44.61 11
3.44.61 11
40.75.89 11
6.49.89 11
6.36.49 11
6.35.49 11
2.11.60 11
36.75.84 10
74.82.83 10
5.41.75 10
16.42.69 10
11.38.62 10
23.42.62 10
30.51.72 10
53.54.88 10
21.49.54 10
46.54.86 10
7.33.69 10
41.63.75 10
6.45.46 10
9.20.84 10
44.49.62 10
44.49.54 10
6.49.54 10
36.57.77 10
15.56.84 10
53.61.84 10
27.33.84 10
45.49.59 10
8.27.75 10
8.25.75 10
6.45.49 10

 

[keeper]

le ho sviluppate in questo modo

01 03 06 10
01 03 06 16
01 03 06 62
01 03 10 16
01 03 10 62
01 03 16 62
01 06 10 16
01 06 10 62
01 06 16 62
01 10 16 62
03 06 10 16
03 06 10 62
03 06 16 62
03 10 16 62
06 10 16 62

01.03.06.10.16.62

questo è il risultato

102 - 27/08/2013 2 01 16
103 - 27/08/2013 2 10 62
106 - 27/08/2013 2 01 03
108 - 27/08/2013 3 06 10 62
109 - 27/08/2013 2 01 10
110 - 27/08/2013 2 16 62
111 - 27/08/2013 4 01 03 06 16
118 - 27/08/2013 2 16 62
121 - 27/08/2013 3 01 10 16
125 - 27/08/2013 2 01 62
126 - 27/08/2013 2 10 16

 

[keeper]

xabio ma lo script per fasce orarie di luigib ce l'hai

 

[xabio]

xabio ma lo script per fasce orarie di luigib ce l'hai

Si ciao e questo :

http://forum.lottoced.com/f12/10el5m-fasce-orarie-cercasi-106722/

e' un esempio poi devi adeguarlo o inserirlo in uno script .

 

[xabio]

Ciao devo giocare domani la terzina 9-33-36 tra le 8.30/10.30
se non esce entro le 10 vado a giocare le ultime 6 estrazioni 10,30 compresa mi sembra la n°125
il ritardo e alto 1585 e alle 10 sara 1604.
Ciao

 

[xabio]

Si volevo fare una precisazione .

Ho notato che parlare di orario di estrazione puo generare errori nelle giocate in ricevitoria
poiche la lottomatica spesso salta qualche estrazione durante le 24 ore
continuando con la numerazione indice progressiva la quale a fine giornata risulta essere 287 piottosto che 288 ma che
sballa l'orario di riferimento.

Con Spaziometria facciamo la statistica sull'indice prograssivo e siamo ok se ci basiamo su questo.

Quindi detto cio' la terzina che andro' a giocare domani la 9-33-36 e' riferita alla fascia 102-126 compresi quindi
se non sortira' prima della 121 la mettero in gioco alla 121,22,23,24,25,26 per 6 colpi .

Buonanotte.

 

[stupl]

Domanda

Domanda

Salve a tutti, come da oggetto volevo chiedere quale programma usare per gli script che postate?

Grazie

 

[xabio]

Keeper.
Quote Originally Posted by keeper View Post
xabio ma lo script per fasce orarie di luigib ce l'hai


Ma lo script di Luigi che avevi messo stamattina dove e' finito !!

 

[keeper]

è sparito
asp lo rimetto

 

[keeper]

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

 

[xabio]

Grazie .
Non e' acora sortita la mia terzina comunque ho speso solo 2 euro domani ci riprovo.
Ciao