Per Luigi -- funzione SerieFreq

claudio8 · 4 Febbraio 2012

LuigiB ha scritto:
perche la tabella è troncata e per questo non funziona la conversione in orizzontale.

ok. è un lavoro da studiare
ciao

LuigiB · 5 Febbraio 2012

devi levare il parametro nRighemax e mettere il ,1

claudio8 · 5 Febbraio 2012

ok. Luigi
ciao anzi, buona notte

Roby · 5 Febbraio 2012

BuonaNotte anche a te..... Claudio
Notte a tutti

Roby · 5 Febbraio 2012

Visto che non si può sempre approffittare della bontà del buon Luigi
Ho provato ad inserire un imputbox con inizio estrazioni a scelta,
e qualche piccola modifica sulle scritte: presenze e frequenze etc... etc...(giusto per adattarlo a mio piacimento)
Ho fatto qualche prova e sembra tutto a posto.............
Ciao

Codice:

Option Explicit
Class clsAmbo
	Private aNumeri(2)
	Private m_Presenze
	Private m_Key
	Private m_Ritardo
	Private m_RitardoMax
	Public Property Let Key(v)
	m_Key = v
	End Property
	Public Property Get Key()
	Key = m_Key
	End Property
	Public Property Get Presenze()
	Presenze = m_Presenze
	End Property
	Public Property Let Presenze(v)
	m_Presenze = v
	End Property
	Public Property Get NumeriString
	NumeriString = StringaNumeri(aNumeri,,True)
	End Property
	Public Property Get Ritardo
	Ritardo = m_Ritardo
	End Property
	Public Property Get RitardoMax
	RitardoMax = m_RitardoMax
	End Property
	Sub SetNumero(id,Numero)
		aNumeri(id) = Numero
	End Sub
	Sub StatisticaAmbo(nInizio,nFine,nRuota)
		ReDim aRuota(1)
		aRuota(1) = nRuota
		Call StatisticaFormazione(aNumeri,aRuota,2,m_Ritardo,m_RitardoMax,0,0,nInizio,nFine)
	End Sub
End Class
Class clsEstrazione
	Private m_collAmbi
	Private m_IdEst
	Private m_Inizio
	Private m_Fine
	Public Property Get Inizio
	Inizio = m_Inizio
	End Property
	Public Property Let Inizio(v)
	m_Inizio = v
	End Property
	Public Property Get Fine
	Fine = m_Fine
	End Property
	Public Property Let Fine(v)
	m_Fine = v
	End Property
	Public Property Get CollAmbi
	Set CollAmbi = m_collAmbi
	End Property
	Public Property Let IdEst(v)
	m_IdEst = v
	End Property
	Public Property Get IdEst()
	IdEst = m_IdEst
	End Property
	Sub Init(idEstr)
		Set m_collAmbi = GetNewCollection
		m_IdEst = idEstr
		m_Inizio = idEstr + 1
	End Sub
	Sub AddAmbo(aColonne,idColonna)
		Dim cAmbo
		Dim sKey
		sKey = "k" & Format2(aColonne(idColonna,1)) & "-" & Format2(aColonne(idColonna,2))
		Set cAmbo = GetItem(sKey,m_collAmbi)
		If cAmbo Is Nothing Then
			Set cAmbo = New clsAmbo
			Call cAmbo.SetNumero(1,aColonne(idColonna,1))
			Call cAmbo.SetNumero(2,aColonne(idColonna,2))
			cAmbo.Presenze = 1
			cAmbo.key = sKey
			m_collAmbi.Add cAmbo,sKey
		Else
			cAmbo.Presenze = cAmbo.Presenze + 1
		End If
	End Sub
	Function IsAmboPresente(sKey)
		Dim cAmbo
		Set cAmbo = GetItem(sKey,m_collAmbi)
		If Not(cAmbo Is Nothing) Then
			IsAmboPresente = True
		End If
	End Function
	Function GetAmboPiuFreq(nRetFrq)
		Dim cAmbo
		If m_collAmbi.count > 0 Then
			Call OrdinaItemCollection(m_collAmbi,"Presenze")
			Set cAmbo = m_collAmbi(1)
			GetAmboPiuFreq = cAmbo.NumeriString
			nRetFrq = cAmbo.Presenze
		Else
			GetAmboPiuFreq = ""
		End If
	End Function
End Class
Sub Main
	Dim nSpia
	Dim nInizio,nFine,nColpi
	Dim idEstr,k,e,i
	Dim nRuota
	Dim aColonne
	Dim cAmbo,cEstr
	Dim sKey
	Dim CollAmbi
	Dim CollEstrazioni
	Dim CollAmbiTot
	Dim bTrovato
	Dim ax
	Const RigheMaxTabAmbiFreq = 20
	Const RigheMaxTabCopertura = 20
	Const RigheMaxRiepilogo = 20
	ax = CInt(InputBox("Inserisci estrazione iniziale?","Inizio",7792))
	nSpia = CInt(InputBox("Inserisci Numero Spia",,76))
	nColpi = CInt(InputBox("Inserisci colpi",,6))
	nInizio = ax
	nFine = EstrazioneFin
	nRuota = ScegliRuota
	Set CollAmbi = GetNewCollection
	Set CollEstrazioni = GetNewCollection
	Set CollAmbiTot = GetNewCollection
	If isNumeroValidoLotto(nSpia) And nColpi > 0 And nRuota > 0 Then
		For idEstr = nInizio To nFine
			bTrovato = IsNumeroPresenteInEstrazione(idEstr,nRuota,nSpia,0)
			If bTrovato Then
				Set cEstr = New clsEstrazione
				Call cEstr.Init(idEstr)
				For i = idEstr + 1 To idEstr + nColpi
					ReDim aNum(5)
					Call GetArrayNumeriRuota(i,nRuota,aNum)
					If aNum(1) > 0 Then
						Call OrdinaMatrice(aNum,1)
						aColonne = SviluppoIntegrale(aNum,2)
						For k = 1 To UBound(aColonne)
							Call cEstr.AddAmbo(aColonne,k)
							sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
							Set cAmbo = GetItem(sKey,CollAmbi)
							If cAmbo Is Nothing Then
								Set cAmbo = New clsAmbo
								cAmbo.key = sKey
								Call cAmbo.SetNumero(1,aColonne(k,1))
								Call cAmbo.SetNumero(2,aColonne(k,2))
								cAmbo.Presenze = 1
								CollAmbi.Add cAmbo,sKey
							Else
								cAmbo.Presenze = cAmbo.Presenze + 1
							End If
						Next
					End If
					cEstr.fine = i
					If IsNumeroPresenteInEstrazione(i,nRuota,nSpia,0) Then
						idEstr = i - 1
						Exit For
					End If
				Next
				CollEstrazioni.Add cEstr,"k" & cEstr.idEst
			End If
			Call AvanzamentoElab(nInizio,nFine,idEstr)
			If ScriptInterrotto Then Exit For
		Next
		Call OrdinaItemCollection(CollAmbi,"Presenze","Key")
		Call CalcolaCopertura(CollAmbiTot,CollEstrazioni)
		Call CreaTabRiepilogo(CollAmbi,CollAmbiTot,CollEstrazioni.count,nInizio,nFine,nRuota,RigheMaxRiepilogo)
		Call CreaTabPresenze(CollAmbi,RigheMaxTabAmbiFreq)
		Call CreaTabCopertura(CollAmbiTot,CollEstrazioni,RigheMaxTabCopertura)
		Call CreaTabCasiRilevati(CollEstrazioni,nSpia,nColpi,nRuota)
	End If
End Sub
Function GetItem(sKey,CollAmbi)
	On Error Resume Next
	Set GetItem = Nothing
	Set GetItem = CollAmbi(sKey)
End Function
Sub AlimentaCollAmbiTot(collAmbi)
	Dim k,sKey
	ReDim aNum(90)
	Dim aColonne
	Dim cAmbo
	For k = 1 To 90
		aNum(k) = k
	Next
	aColonne = SviluppoIntegrale(aNum,2)
	For k = 1 To UBound(aColonne)
		sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
		Set cAmbo = New clsAmbo
		cAmbo.key = sKey
		Call cAmbo.SetNumero(1,aColonne(k,1))
		Call cAmbo.SetNumero(2,aColonne(k,2))
		cAmbo.Presenze = 0
		collAmbi.Add cAmbo,sKey
	Next
End Sub
Sub GetColoriRiga(aColori,nColDaEvid,ColoreLastCol)
	ReDim aColori(12)
	Dim k
	For k = 1 To 12
		If k = nColDaEvid Then
			aColori(k) = vbYellow
		Else
			aColori(k) = vbWhite
		End If
	Next
	aColori(12) = ColoreLastCol
End Sub
Sub CalcolaCopertura(CollAmbiTot,CollEstrazioni)
	TestoInBandaPassante "AMBI + FREQUENTI E + PRESENTI DOPO NUMERO SPIA - PER BLACKMORE - LISTATO BY LUIGIB -",1,1,4
	Scrivi
	ColoreTesto 0
	Dim cAmbo
	Dim k
	Dim cEstr
	' tabella copertura
	Call Messaggio("Calcolo copertura estrazioni")
	Call AlimentaCollAmbiTot(CollAmbiTot)
	k = 0
	For Each cAmbo In CollAmbiTot
		For Each cEstr In CollEstrazioni
			If cEstr.IsAmboPresente(cAmbo.key) Then
				cAmbo.presenze = cAmbo.presenze + 1
			End If
		Next
		k = k + 1
		Call AvanzamentoElab(1,CollAmbiTot.count,k)
		If ScriptInterrotto Then Exit For
	Next
End Sub
Sub CreaTabCopertura(CollAmbiTot,CollEstrazioni,nRigheMax)
	Dim cAmbo
	Dim k
	Dim cEstr
	Call OrdinaItemCollection(CollAmbiTot,"Presenze","Key")
	Call Scrivi("La seguente tabella indica le Presenze degli ambi sulle estrazioni rilevate dai casi (" & CollEstrazioni.count & " casi)")
	Call Scrivi
	' tabella copertura
	ReDim aTitoli(3)
	aTitoli(1) = " Ambo "
	aTitoli(2) = " Presenze "
	aTitoli(3) = " Percentuale "
	Call InitTabella(aTitoli)
	For Each cAmbo In CollAmbiTot
		If cAmbo.presenze > 0 Then
			ReDim aValori(3)
			aValori(1) = cAmbo.NumeriString
			aValori(2) = cAmbo.presenze
			aValori(3) = Round(Dividi((cAmbo.presenze * 100),CollEstrazioni.count),3) & " %"
			Call AddRigaTabella(aValori)
		End If
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabPresenze(CollAmbi,nRigheMax)
	Dim cAmbo
	' tabella presenze
	Call Scrivi("La seguente tabella indica la frequenza degli ambi")
	Call Scrivi
	'Call OrdinaItemCollection(CollAmbi,"Presenze")
	ReDim aTitoli(2)
	aTitoli(1) = " Ambo "
	aTitoli(2) = " Frequenze "
	Call InitTabella(aTitoli)
	For Each cAmbo In CollAmbi
		ReDim aValori(2)
		aValori(1) = cAmbo.NumeriString
		aValori(2) = cAmbo.presenze
		Call AddRigaTabella(aValori)
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabCasiRilevati(CollEstrazioni,nSpia,nColpi,nRuota)
	Dim i,k,n,nPosSpia,nFreq
	Dim cEstr
	' tabella casi rilevati
	Call Scrivi("La seguente tabella indica i casi rilevati (" & CollEstrazioni.count & " casi)")
	Call Scrivi
	Call Messaggio("Riepilogo  casi rilevati")
	ReDim aTitoli(12)
	aTitoli(1) = "Estrazione"
	aTitoli(2) = "Data"
	aTitoli(3) = "I"
	aTitoli(4) = "II"
	aTitoli(5) = "III"
	aTitoli(6) = "IV"
	aTitoli(7) = "V"
	aTitoli(8) = "Presenze"
	aTitoli(9) = "Ambo Piu Frequente"
	aTitoli(10) = "InizioAnalisi"
	aTitoli(11) = "FineAnalisi"
	aTitoli(12) = "EstrazioniSuccessive"
	i = 0
	Call InitTabella(aTitoli)
	For Each cEstr In CollEstrazioni
		ReDim aValori(12)
		aValori(1) = cEstr.idEst
		aValori(2) = DataEstrazione(cEstr.idEst)
		nPosSpia = 0
		For k = 1 To 5
			n = Estratto(cEstr.idEst,nRuota,k)
			aValori(k + 2) = n
			If n = nSpia Then
				nPosSpia = k
			End If
		Next
		aValori(8) = nFreq
		aValori(9) = cEstr.GetAmboPiuFreq(nFreq)
		aValori(10) = cEstr.Inizio
		aValori(11) = cEstr.Fine
		aValori(12) = cEstr.Fine -(cEstr.Inizio - 1)
		ReDim aColori(0)
		Call GetColoriRiga(aColori,nPosSpia + 2,Iif(aValori(12) = nColpi,vbGreen,vbYellow))
		Call AddRigaTabella(aValori,aColori)
		i = i + 1
		Call AvanzamentoElab(1,CollEstrazioni.count,i)
		If ScriptInterrotto Then Exit For
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella()
End Sub
Sub CreaTabRiepilogo(CollAmbi,CollAmbiTot,nCasiTrov,nInizio,nFine,nRuota,nRigheMax)
	Dim cAmboF,cAmboP
	Dim i
	Call Messaggio("Tabella riepilogo")
	' tabella presenze
	Call Scrivi("La seguente tabella indica la frequenza degli ambi e le rispettive presenze")
	Call Scrivi
	ReDim aTitoli(8)
	aTitoli(1) = "Ambo"
	aTitoli(2) = "Presenze"
	aTitoli(3) = "Percentuale"
	aTitoli(4) = "Frequenza"
	aTitoli(5) = "Freq/Pres"
	aTitoli(6) = "Ritardo"
	aTitoli(7) = "RitMax"
	aTitoli(8) = "Ultima"
	Call InitTabella(aTitoli,vbBlue,,,vbWhite)
	ReDim aColori(8)
	aColori(1) = vbCyan
	aColori(2) = vbGreen
	aColori(3) = vbYellow
	aColori(4) = vbGreen
	aColori(5) = RGB(255,100,100)
	aColori(6) = RGB(255,90,90)
	aColori(7) = RGB(255,80,80)
	aColori(8) = RGB(255,70,70)
	For Each cAmboF In CollAmbi
		Set cAmboP = CollAmbiTot(cAmboF.key)
		Call cAmboF.StatisticaAmbo(nInizio,nFine,nRuota)
		ReDim aValori(8)
		aValori(1) = cAmboF.NumeriString
		aValori(2) = cAmboP. presenze
		aValori(3) = Round(Dividi((cAmboP.presenze * 100),nCasiTrov),3) & " % "
		aValori(4) = cAmboF.presenze
		aValori(5) = Round(Dividi(cAmboF.presenze,cAmboP.presenze),3)
		aValori(6) = cAmboF.Ritardo
		aValori(7) = cAmboF.RitardoMax
		aValori(8) = nFine - cAmboF.ritardo
		Call AddRigaTabella(aValori,aColori)
		i = i + 1
		Call AvanzamentoElab(1,nRigheMax,i)
		If ScriptInterrotto Then Exit For
		If i = nRigheMax Then Exit For
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella(2,- 1,,nRigheMax,0)
End Sub

joi_lotto · 5 Febbraio 2012

Bravi Bravi è veramente bello, adesso chiedo

sicuramente sarò mandato a quel paese,per non essere volgare) è possibile inserire oltre i numuri degli ambi, i mesi in cui sono usciti ?
Esempio: spia 76 uscita 50 volte dal...al.... mese di gen. n. ambi, mese di feb. n. ambi, ecc. ecc. Così se la spia 76 ogni volta che è uscita in gen. sono usciti nei colpi successivi indicati n. ambi.
Spero di essere stato chiaro.
BUONANOTTE.
Joi

claudio8 · 5 Febbraio 2012

Joi non è per essere distruttivo ma ho provato a dare sulla spia 76 un inizio da estrazione 7000, ( marzo 2001) ci sono 69 casi
con l'ambo 6-59 presente 6 volte, con una % di copertura inferiore al 10%, non penserai mica che sia così puntuale che possa
uscire specificatamente nel mese di ......

Su dai cerchiamo di essere un tantino + realistici vi e anche un limite alla ricerca, tutto deve rientrare in un generale concetto di casualità ragionevole.

Ciao

claudio8 · 5 Febbraio 2012

X black, visto che hai cominciato a mettere le mani sullo script, ti consiglierei di sostituire il tuo inputbox con "Quante estrazioni vuoi controllare?"
in modo che queste ne difiniscono la data perche per noi che non usiamo il tuo programma, viene + facile ragionare in termini di estrazioni.
Grazie.

Antonin · 5 Febbraio 2012

Ciao LuigiB o claudio8 a me da'questo errore:Call GetArrayNumeriRuota(i,nRuota,aNum).

LuigiB · 5 Febbraio 2012

probabilmente perche avrai ancora la vecchia versione che usava Garibaldi ai suoi tempi ....
AGGIORNARE SEMPRE ALL'ULTIMA VERSIONE !!!

Lo so che è una scocciatura ma se rilascio le nuove versioni ci saranno dei buoni motivi o no ?

Roby · 5 Febbraio 2012

Ciao Claudio, hai ragione, l'ho fatto un po troppo secondo le mie esigenze, eheheh
Modificato l'imputbox in: Quante estrazioni vuoi controllare?
Dovrebbe essere ok
Ciao

Codice:

Option Explicit
Class clsAmbo
Private aNumeri(2)
Private m_Presenze
Private m_Key
Private m_Ritardo
Private m_RitardoMax
Public Property Let Key(v)
m_Key = v
End Property
Public Property Get Key()
Key = m_Key
End Property
Public Property Get Presenze()
Presenze = m_Presenze
End Property
Public Property Let Presenze(v)
m_Presenze = v
End Property
Public Property Get NumeriString
NumeriString = StringaNumeri(aNumeri,,True)
End Property
Public Property Get Ritardo
Ritardo = m_Ritardo
End Property
Public Property Get RitardoMax
RitardoMax = m_RitardoMax
End Property
Sub SetNumero(id,Numero)
aNumeri(id) = Numero
End Sub
Sub StatisticaAmbo(nInizio,nFine,nRuota)
ReDim aRuota(1)
aRuota(1) = nRuota
Call StatisticaFormazione(aNumeri,aRuota,2,m_Ritardo,m_RitardoMax,0,0,nInizio,nFine)
End Sub
End Class
Class clsEstrazione
Private m_collAmbi
Private m_IdEst
Private m_Inizio
Private m_Fine
Public Property Get Inizio
Inizio = m_Inizio
End Property
Public Property Let Inizio(v)
m_Inizio = v
End Property
Public Property Get Fine
Fine = m_Fine
End Property
Public Property Let Fine(v)
m_Fine = v
End Property
Public Property Get CollAmbi
Set CollAmbi = m_collAmbi
End Property
Public Property Let IdEst(v)
m_IdEst = v
End Property
Public Property Get IdEst()
IdEst = m_IdEst
End Property
Sub Init(idEstr)
Set m_collAmbi = GetNewCollection
m_IdEst = idEstr
m_Inizio = idEstr + 1
End Sub
Sub AddAmbo(aColonne,idColonna)
Dim cAmbo
Dim sKey
sKey = "k" & Format2(aColonne(idColonna,1)) & "-" & Format2(aColonne(idColonna,2))
Set cAmbo = GetItem(sKey,m_collAmbi)
If cAmbo Is Nothing Then
Set cAmbo = New clsAmbo
Call cAmbo.SetNumero(1,aColonne(idColonna,1))
Call cAmbo.SetNumero(2,aColonne(idColonna,2))
cAmbo.Presenze = 1
cAmbo.key = sKey
m_collAmbi.Add cAmbo,sKey
Else
cAmbo.Presenze = cAmbo.Presenze + 1
End If
End Sub
Function IsAmboPresente(sKey)
Dim cAmbo
Set cAmbo = GetItem(sKey,m_collAmbi)
If Not(cAmbo Is Nothing) Then
IsAmboPresente = True
End If
End Function
Function GetAmboPiuFreq(nRetFrq)
Dim cAmbo
If m_collAmbi.count > 0 Then
Call OrdinaItemCollection(m_collAmbi,"Presenze")
Set cAmbo = m_collAmbi(1)
GetAmboPiuFreq = cAmbo.NumeriString
nRetFrq = cAmbo.Presenze
Else
GetAmboPiuFreq = ""
End If
End Function
End Class
Sub Main
Dim nSpia
Dim nInizio,nFine,nColpi
Dim idEstr,k,e,i
Dim nRuota
Dim aColonne
Dim cAmbo,cEstr
Dim sKey
Dim CollAmbi
Dim CollEstrazioni
Dim CollAmbiTot
Dim bTrovato
Dim ax
Const RigheMaxTabAmbiFreq = 20
Const RigheMaxTabCopertura = 20
Const RigheMaxRiepilogo = 20
ax = CInt(InputBox("Quante estrazioni vuoi controllare?",,1000))
nSpia = CInt(InputBox("Inserisci Numero Spia",,76))
nColpi = CInt(InputBox("Inserisci colpi",,6))
nInizio = EstrazioneFin - ax
nFine = EstrazioneFin
nRuota = ScegliRuota
Set CollAmbi = GetNewCollection
Set CollEstrazioni = GetNewCollection
Set CollAmbiTot = GetNewCollection
If isNumeroValidoLotto(nSpia) And nColpi > 0 And nRuota > 0 Then
For idEstr = nInizio To nFine
bTrovato = IsNumeroPresenteInEstrazione(idEstr,nRuota,nSpia,0)
If bTrovato Then
Set cEstr = New clsEstrazione
Call cEstr.Init(idEstr)
For i = idEstr + 1 To idEstr + nColpi
ReDim aNum(5)
Call GetArrayNumeriRuota(i,nRuota,aNum)
If aNum(1) > 0 Then
Call OrdinaMatrice(aNum,1)
aColonne = SviluppoIntegrale(aNum,2)
For k = 1 To UBound(aColonne)
Call cEstr.AddAmbo(aColonne,k)
sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
Set cAmbo = GetItem(sKey,CollAmbi)
If cAmbo Is Nothing Then
Set cAmbo = New clsAmbo
cAmbo.key = sKey
Call cAmbo.SetNumero(1,aColonne(k,1))
Call cAmbo.SetNumero(2,aColonne(k,2))
cAmbo.Presenze = 1
CollAmbi.Add cAmbo,sKey
Else
cAmbo.Presenze = cAmbo.Presenze + 1
End If
Next
End If
cEstr.fine = i
If IsNumeroPresenteInEstrazione(i,nRuota,nSpia,0) Then
idEstr = i - 1
Exit For
End If
Next
CollEstrazioni.Add cEstr,"k" & cEstr.idEst
End If
Call AvanzamentoElab(nInizio,nFine,idEstr)
If ScriptInterrotto Then Exit For
Next
Call OrdinaItemCollection(CollAmbi,"Presenze","Key")
Call CalcolaCopertura(CollAmbiTot,CollEstrazioni)
Call CreaTabRiepilogo(CollAmbi,CollAmbiTot,CollEstrazioni.count,nInizio,nFine,nRuota,RigheMaxRiepilogo)
Call CreaTabPresenze(CollAmbi,RigheMaxTabAmbiFreq)
Call CreaTabCopertura(CollAmbiTot,CollEstrazioni,RigheMaxTabCopertura)
Call CreaTabCasiRilevati(CollEstrazioni,nSpia,nColpi,nRuota)
End If
End Sub
Function GetItem(sKey,CollAmbi)
On Error Resume Next
Set GetItem = Nothing
Set GetItem = CollAmbi(sKey)
End Function
Sub AlimentaCollAmbiTot(collAmbi)
Dim k,sKey
ReDim aNum(90)
Dim aColonne
Dim cAmbo
For k = 1 To 90
aNum(k) = k
Next
aColonne = SviluppoIntegrale(aNum,2)
For k = 1 To UBound(aColonne)
sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
Set cAmbo = New clsAmbo
cAmbo.key = sKey
Call cAmbo.SetNumero(1,aColonne(k,1))
Call cAmbo.SetNumero(2,aColonne(k,2))
cAmbo.Presenze = 0
collAmbi.Add cAmbo,sKey
Next
End Sub
Sub GetColoriRiga(aColori,nColDaEvid,ColoreLastCol)
ReDim aColori(12)
Dim k
For k = 1 To 12
If k = nColDaEvid Then
aColori(k) = vbYellow
Else
aColori(k) = vbWhite
End If
Next
aColori(12) = ColoreLastCol
End Sub
Sub CalcolaCopertura(CollAmbiTot,CollEstrazioni)
TestoInBandaPassante "AMBI + FREQUENTI E + PRESENTI DOPO NUMERO SPIA - PER BLACKMORE - LISTATO BY LUIGIB -",1,1,4
Scrivi
ColoreTesto 0
Dim cAmbo
Dim k
Dim cEstr
' tabella copertura
Call Messaggio("Calcolo copertura estrazioni")
Call AlimentaCollAmbiTot(CollAmbiTot)
k = 0
For Each cAmbo In CollAmbiTot
For Each cEstr In CollEstrazioni
If cEstr.IsAmboPresente(cAmbo.key) Then
cAmbo.presenze = cAmbo.presenze + 1
End If
Next
k = k + 1
Call AvanzamentoElab(1,CollAmbiTot.count,k)
If ScriptInterrotto Then Exit For
Next
End Sub
Sub CreaTabCopertura(CollAmbiTot,CollEstrazioni,nRigheMax)
Dim cAmbo
Dim k
Dim cEstr
Call OrdinaItemCollection(CollAmbiTot,"Presenze","Key")
Call Scrivi("La seguente tabella indica le Presenze degli ambi sulle estrazioni rilevate dai casi (" & CollEstrazioni.count & " casi)")
Call Scrivi
' tabella copertura
ReDim aTitoli(3)
aTitoli(1) = " Ambo "
aTitoli(2) = " Presenze "
aTitoli(3) = " Percentuale "
Call InitTabella(aTitoli)
For Each cAmbo In CollAmbiTot
If cAmbo.presenze > 0 Then
ReDim aValori(3)
aValori(1) = cAmbo.NumeriString
aValori(2) = cAmbo.presenze
aValori(3) = Round(Dividi((cAmbo.presenze * 100),CollEstrazioni.count),3) & " %"
Call AddRigaTabella(aValori)
End If
Next
Call Messaggio("Creazione tabella in corso ...")
Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabPresenze(CollAmbi,nRigheMax)
Dim cAmbo
' tabella presenze
Call Scrivi("La seguente tabella indica la frequenza degli ambi")
Call Scrivi
'Call OrdinaItemCollection(CollAmbi,"Presenze")
ReDim aTitoli(2)
aTitoli(1) = " Ambo "
aTitoli(2) = " Frequenze "
Call InitTabella(aTitoli)
For Each cAmbo In CollAmbi
ReDim aValori(2)
aValori(1) = cAmbo.NumeriString
aValori(2) = cAmbo.presenze
Call AddRigaTabella(aValori)
Next
Call Messaggio("Creazione tabella in corso ...")
Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabCasiRilevati(CollEstrazioni,nSpia,nColpi,nRuota)
Dim i,k,n,nPosSpia,nFreq
Dim cEstr
' tabella casi rilevati
Call Scrivi("La seguente tabella indica i casi rilevati (" & CollEstrazioni.count & " casi)")
Call Scrivi
Call Messaggio("Riepilogo  casi rilevati")
ReDim aTitoli(12)
aTitoli(1) = "Estrazione"
aTitoli(2) = "Data"
aTitoli(3) = "I"
aTitoli(4) = "II"
aTitoli(5) = "III"
aTitoli(6) = "IV"
aTitoli(7) = "V"
aTitoli(8) = "Presenze"
aTitoli(9) = "Ambo Piu Frequente"
aTitoli(10) = "InizioAnalisi"
aTitoli(11) = "FineAnalisi"
aTitoli(12) = "EstrazioniSuccessive"
i = 0
Call InitTabella(aTitoli)
For Each cEstr In CollEstrazioni
ReDim aValori(12)
aValori(1) = cEstr.idEst
aValori(2) = DataEstrazione(cEstr.idEst)
nPosSpia = 0
For k = 1 To 5
n = Estratto(cEstr.idEst,nRuota,k)
aValori(k + 2) = n
If n = nSpia Then
nPosSpia = k
End If
Next
aValori(8) = nFreq
aValori(9) = cEstr.GetAmboPiuFreq(nFreq)
aValori(10) = cEstr.Inizio
aValori(11) = cEstr.Fine
aValori(12) = cEstr.Fine -(cEstr.Inizio - 1)
ReDim aColori(0)
Call GetColoriRiga(aColori,nPosSpia + 2,Iif(aValori(12) = nColpi,vbGreen,vbYellow))
Call AddRigaTabella(aValori,aColori)
i = i + 1
Call AvanzamentoElab(1,CollEstrazioni.count,i)
If ScriptInterrotto Then Exit For
Next
Call Messaggio("Creazione tabella in corso ...")
Call CreaTabella()
End Sub
Sub CreaTabRiepilogo(CollAmbi,CollAmbiTot,nCasiTrov,nInizio,nFine,nRuota,nRigheMax)
Dim cAmboF,cAmboP
Dim i
Call Messaggio("Tabella riepilogo")
' tabella presenze
Call Scrivi("La seguente tabella indica la frequenza degli ambi e le rispettive presenze")
Call Scrivi
ReDim aTitoli(8)
aTitoli(1) = "Ambo"
aTitoli(2) = "Presenze"
aTitoli(3) = "Percentuale"
aTitoli(4) = "Frequenza"
aTitoli(5) = "Freq/Pres"
aTitoli(6) = "Ritardo"
aTitoli(7) = "RitMax"
aTitoli(8) = "Ultima"
Call InitTabella(aTitoli,vbBlue,,,vbWhite)
ReDim aColori(8)
aColori(1) = vbCyan
aColori(2) = vbGreen
aColori(3) = vbYellow
aColori(4) = vbGreen
aColori(5) = RGB(255,100,100)
aColori(6) = RGB(255,90,90)
aColori(7) = RGB(255,80,80)
aColori(8) = RGB(255,70,70)
For Each cAmboF In CollAmbi
Set cAmboP = CollAmbiTot(cAmboF.key)
Call cAmboF.StatisticaAmbo(nInizio,nFine,nRuota)
ReDim aValori(8)
aValori(1) = cAmboF.NumeriString
aValori(2) = cAmboP. presenze
aValori(3) = Round(Dividi((cAmboP.presenze * 100),nCasiTrov),3) & " % "
aValori(4) = cAmboF.presenze
aValori(5) = Round(Dividi(cAmboF.presenze,cAmboP.presenze),3)
aValori(6) = cAmboF.Ritardo
aValori(7) = cAmboF.RitardoMax
aValori(8) = nFine - cAmboF.ritardo
Call AddRigaTabella(aValori,aColori)
i = i + 1
Call AvanzamentoElab(1,nRigheMax,i)
If ScriptInterrotto Then Exit For
If i = nRigheMax Then Exit For
Next
Call Messaggio("Creazione tabella in corso ...")
Call CreaTabella(2,- 1,,nRigheMax,0)
End Sub

claudio8 · 5 Febbraio 2012

LuigiB ha scritto:
probabilmente perche avrai ancora la vecchia versione che usava Garibaldi ai suoi tempi ....

Caro Luigi, mi congratulo con te.

Visto che hai inizia questa avventura a circa 40 anni e le prime versioni risalgono ai tempi di Garibaldi, ( 1861 )
e se 2+2 fa 4 allora hai da poco compiuto 191 anni , non 42 ehhehhe....
augurissimi,
vedo che li porti egregiamente.

claudio8 · 5 Febbraio 2012

Black .... sei Bravissimo

joi_lotto · 5 Febbraio 2012

claudio8 ha scritto:
Joi non è per essere distruttivo ma ho provato a dare sulla spia 76 un inizio da estrazione 7000, ( marzo 2001) ci sono 69 casi
con l'ambo 6-59 presente 6 volte, con una % di copertura inferiore al 10%, non penserai mica che sia così puntuale che possa
uscire specificatamente nel mese di ......

Su dai cerchiamo di essere un tantino + realistici vi e anche un limite alla ricerca, tutto deve rientrare in un generale concetto di casualità ragionevole.

Ciao

Ciao Claudio, io non dico che debba essere puntuale come dici tu, era solo per avere una statistica, qualche dato in più.
Sappiamo che da qundo è nato questo giuoco le varianti sono state diverse. Con poche ruote, aggiunta di ruote, aggiunta di estrazioni,che a parer mio ogni periodo a una sua statisca, non credi ?
Comunque ripeto e ribadisco SIETE BRAVISSIMI e non poco importante la VOSTRA DISPONIBILITA' che al giorno d'oggi è una cosa alquanto rara.
Grazie
SALUTONI a tutti Voi.
Joi.

Antonin · 5 Febbraio 2012

Grazie LuigiB sempre gentile.

Antonin · 5 Febbraio 2012

Ciao blackmore o chi mi vorra' rispondere,si potrebbe modificare anche per estratto e con le decine naturali a mia scelta.Grazie

Roby · 6 Febbraio 2012

Io non sono in grado, mi dispiace

LuigiB · 6 Febbraio 2012

questo script che posto funziona solo con la nuova versione che emttero entro stasera.
E' molto piu articolato del precedente.

Codice:

Option Explicit
Class clsAmbo
	Private aNumeri(2)
	Private m_Presenze
	Private m_Key
	Private m_Ritardo
	Private m_RitardoMax
	Public Property Let Key(v)
		m_Key = v
	End Property
	Public Property Get Key()
		Key = m_Key
	End Property
	Public Property Get Presenze()
		Presenze = m_Presenze
	End Property
	Public Property Let Presenze(v)
		m_Presenze = v
	End Property
	Public Property Get NumeriString
		NumeriString = StringaNumeri(aNumeri,,True)
	End Property
	Public Property Get Ritardo
		Ritardo = m_Ritardo
	End Property
	Public Property Get RitardoMax
		RitardoMax = m_RitardoMax
	End Property
	Sub SetNumero(id,Numero)
		aNumeri(id) = Numero
	End Sub
	Sub StatisticaAmbo(nInizio,nFine,nRuota)
		ReDim aRuota(1)
		aRuota(1) = nRuota
		Call StatisticaFormazione(aNumeri,aRuota,2,m_Ritardo,m_RitardoMax,0,0,nInizio,nFine)
	End Sub
End Class
Class clsEstrazione
	Private m_collAmbi
	Private m_IdEst
	Private m_Inizio
	Private m_Fine
	Private m_aNumRilevati	
	Public Property Get Inizio
		Inizio = m_Inizio
	End Property
	Public Property Let Inizio(v)
		m_Inizio = v
	End Property
	Public Property Get Fine
		Fine = m_Fine
	End Property
	Public Property Let Fine(v)
		m_Fine = v
	End Property
	Public Property Get CollAmbi
		Set CollAmbi = m_collAmbi
	End Property
	Public Property Let IdEst(v)
		m_IdEst = v
	End Property
	Public Property Get IdEst()
		IdEst = m_IdEst
	End Property
	Public Property Let aNumRilevati(v)
	
		m_aNumRilevati = v
	End Property
	Public Property Get aNumRilevati
	
		aNumRilevati = m_aNumRilevati
	End Property
	

	Sub Init(idEstr)
		Set m_collAmbi = GetNewCollection
		m_IdEst = idEstr
		m_Inizio = idEstr + 1
	End Sub
	Sub AddAmbo(aColonne,idColonna)
		Dim cAmbo
		Dim sKey
		sKey = "k" & Format2(aColonne(idColonna,1)) & "-" & Format2(aColonne(idColonna,2))
		Set cAmbo = GetItem(sKey,m_collAmbi)
		If cAmbo Is Nothing Then
			Set cAmbo = New clsAmbo
			Call cAmbo.SetNumero(1,aColonne(idColonna,1))
			Call cAmbo.SetNumero(2,aColonne(idColonna,2))
			cAmbo.Presenze = 1
			cAmbo.key = sKey
			m_collAmbi.Add cAmbo,sKey
		Else
			cAmbo.Presenze = cAmbo.Presenze + 1
		End If
	End Sub
	Function IsAmboPresente(sKey)
		Dim cAmbo
		Set cAmbo = GetItem(sKey,m_collAmbi)
		If Not(cAmbo Is Nothing) Then
			IsAmboPresente = True
		End If
	End Function
	Function GetAmboPiuFreq(nRetFrq)
		Dim cAmbo
		If m_collAmbi.count > 0 Then
			Call OrdinaItemCollection(m_collAmbi,"Presenze")
			Set cAmbo = m_collAmbi(1)
			GetAmboPiuFreq = cAmbo.NumeriString
			nRetFrq = cAmbo.Presenze
		Else
			GetAmboPiuFreq = ""
		End If
	End Function
End Class
Sub Main
	Dim nInizio,nFine,nColpi
	Dim idEstr,k,e,i
	Dim nRuota
	Dim aColonne
	Dim cAmbo,cEstr
	Dim sKey
	Dim CollAmbi
	Dim CollEstrazioni
	Dim CollAmbiTot
	Dim bTrovato
	Dim TipoRicerca
	Dim aElemFormazione
	Const RigheMaxTabAmbiFreq = 20
	Const RigheMaxTabCopertura = 20
	Const RigheMaxRiepilogo = 20
	Dim aNumDaCercare
	Dim nPuntiDaFare
	Dim nClasseFrz
	
	TipoRicerca = GetTipoRicerca
	nColpi = CInt(InputBox("Inserisci colpi",,10))
	nInizio = EstrazioneIni
	nFine = EstrazioneFin
	nRuota = ScegliRuota
	Set CollAmbi = GetNewCollection
	Set CollEstrazioni = GetNewCollection
	Set CollAmbiTot = GetNewCollection
	If TipoRicerca = 0 Then
		' numero spia
		ReDim aNumDaCercare(1)
		aNumDaCercare(1) = CInt(InputBox("Inserisci Numero Spia"))
		nPuntiDaFare = 1
	ElseIf TipoRicerca = 1 Then
		' punti su lunghetta
		Call RichiediLunghetta(aNumDaCercare,nPuntiDaFare)
	ElseIf TipoRicerca = 2 Then
		' punti su elemento formazione
		Call RichiediFormazione(aElemFormazione,nPuntiDaFare,nClasseFrz)
		ReDim aNumDaCercare(nClasseFrz)
	Else
		nPuntiDaFare = 1
		ReDim aNumDaCercare(1)

	End If
	If nColpi > 0 And nRuota > 0 And TipoRicerca >= 0 And nPuntiDaFare > 0 Then
		For idEstr = nInizio To nFine
			'bTrovato = IsNumeroPresenteInEstrazione(idEstr,nRuota,nSpia,0)
			bTrovato = VerificaCondizione(TipoRicerca,idEstr,nRuota,aNumDaCercare,nPuntiDaFare,aElemFormazione)

			If bTrovato Then
				Set cEstr = New clsEstrazione
				Call cEstr.Init(idEstr)
				cEstr.aNumRilevati = aNumDaCercare
				For i = idEstr + 1 To idEstr + nColpi
					ReDim aNum(5)
					Call GetArrayNumeriRuota(i,nRuota,aNum)
					If aNum(1) > 0 Then
						Call OrdinaMatrice(aNum,1)
						aColonne = SviluppoIntegrale(aNum,2)
						For k = 1 To UBound(aColonne)
							Call cEstr.AddAmbo(aColonne,k)
							sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
							Set cAmbo = GetItem(sKey,CollAmbi)
							If cAmbo Is Nothing Then
								Set cAmbo = New clsAmbo
								cAmbo.key = sKey
								Call cAmbo.SetNumero(1,aColonne(k,1))
								Call cAmbo.SetNumero(2,aColonne(k,2))
								cAmbo.Presenze = 1
								CollAmbi.Add cAmbo,sKey
							Else
								cAmbo.Presenze = cAmbo.Presenze + 1
							End If
						Next
					End If
					cEstr.fine = i
					If TipoRicerca < 3 Then
						If VerificaCondizione(TipoRicerca,i,nRuota,aNumDaCercare,nPuntiDaFare,aElemFormazione) Then
							idEstr = i - 1
							Exit For
						End If
					End If
				Next
				CollEstrazioni.Add cEstr,"k" & cEstr.idEst
			End If
			Call AvanzamentoElab(nInizio,nFine,idEstr)
			If ScriptInterrotto Then Exit For
		Next
		Call OrdinaItemCollection(CollAmbi,"Presenze","Key")
		Call CalcolaCopertura(CollAmbiTot,CollEstrazioni)
		Call CreaTabRiepilogo(CollAmbi,CollAmbiTot,CollEstrazioni.count,nInizio,nFine,nRuota,RigheMaxRiepilogo)
		Call CreaTabPresenze(CollAmbi,RigheMaxTabAmbiFreq)
		Call CreaTabCopertura(CollAmbiTot,CollEstrazioni,RigheMaxTabCopertura)
		Call CreaTabCasiRilevati(CollEstrazioni,nPuntiDaFare,nColpi,nRuota)
	End If
End Sub
Function VerificaCondizione(TipoRicerca,idEstr,nRuota,aNumDaCercare,nPuntiDaFare,aElemFormazione)
	Dim bTrovato,k,e
	bTrovato = False
	Select Case TipoRicerca
	Case 0 ' numero spia
		bTrovato = IsNumeroPresenteInEstrazione(idEstr,nRuota,aNumDaCercare(1),0)
	Case 1 ' punti su lunghetta
		ReDim aNum(5)
		Call GetArrayNumeriRuota(idEstr,nRuota,aNum)
		If PuntiSuArray(aNum,aNumDaCercare) >= nPuntiDaFare Then
			bTrovato = True
		End If
	Case 2
		ReDim aNum(5)
		Call GetArrayNumeriRuota(idEstr,nRuota,aNum)
		
		For k = 1 To UBound(aElemFormazione)
			For e = 1 To UBound(aNumDaCercare)
				aNumDaCercare(e) = aElemFormazione(k,e)
			Next
			If PuntiSuArray(aNum,aNumDaCercare) >= nPuntiDaFare Then
				bTrovato = True
				Exit For
			End If

			
		Next
	Case 3 ' prima del mese
		If IndiceMensile(idEstr) = 1 Then
			bTrovato = True
		End If
	Case 4 ' ultima del Mese
		If IsUltimaDelMese(idEstr) Then
			bTrovato = True
		End If

	End Select
	VerificaCondizione = bTrovato
End Function
Function GetTipoRicerca()
	ReDim aVoci(4)
	aVoci(0) = "Numero spia"
	aVoci(1) = "Punti su lunghetta"
	aVoci(2) = "Punti su formazione"
	aVoci(3) = "Prima del mese"
	aVoci(4) = "Ultima del mese"
	
	GetTipoRicerca = ScegliOpzioneMenu(aVoci,0,"Selezione tipo ricerca")
End Function
Sub RichiediLunghetta(aNumDaCercare,nPuntiDaFare)
	Dim s
	Dim n
	s = InputBox("Inserire i numeri della lunghetta separati da , (virgola)",,"1,2,3,4")
	n = CInt(InputBox("Inserire i punti da realizzare sulla lunghetta",,1))
	ReDim aNumDaCercare(0)
	Call SplitByChar("0," & s,",",aNumDaCercare)
	If n > 0 Then
		nPuntiDaFare = n
	End If
End Sub
Sub RichiediFormazione(aElemFormazione,nPuntiDaFare,nClasseFrz)

	Dim s
	Dim n
	Dim id
	
	ReDim aNomiForm(0)
	
	Call ElencoFileInDirectory(GetDirectoryAppData & "formazioni\",aNomiForm,".frz")
	id = ScegliOpzioneMenu(aNomiForm,1,"Selezione formazione")
	
	If GetElementiFormazione(aNomiForm(id),aElemFormazione) Then
	
		n = CInt(InputBox("Inserire i punti da realizzare su un qualsiasi elemento della formazione",,1))
		nClasseFrz = GetClasseFormazione(aNomiForm(id))
	End If
	
	If n > 0 Then
		nPuntiDaFare = n
	End If

End Sub
Function GetItem(sKey,CollAmbi)
	On Error Resume Next
	Set GetItem = Nothing
	Set GetItem = CollAmbi(sKey)
End Function
Sub AlimentaCollAmbiTot(collAmbi)
	Dim k,sKey
	Dim aColonne
	Dim cAmbo
	aColonne = SviluppoIntegrale(GetNumPerSviluppo,2)
	For k = 1 To UBound(aColonne)
		sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
		Set cAmbo = New clsAmbo
		cAmbo.key = sKey
		Call cAmbo.SetNumero(1,aColonne(k,1))
		Call cAmbo.SetNumero(2,aColonne(k,2))
		cAmbo.Presenze = 0
		collAmbi.Add cAmbo,sKey
	Next
End Sub
Sub GetColoriRiga(aColori,aColDaEvid,ColoreLastCol)
	ReDim aColori(12)
	Dim k
	For k = 1 To 12
		aColori(k) = vbWhite
	Next
	For k = 1 To UBound(aColDaEvid)
		If aColDaEvid(k) Then
			aColori(k + 2) = vbYellow
		End If
	Next
	aColori(12) = ColoreLastCol
End Sub
Sub CalcolaCopertura(CollAmbiTot,CollEstrazioni)
	Dim cAmbo
	Dim k
	Dim cEstr
	' tabella copertura
	Call Messaggio("Calcolo copertura estrazioni")
	Call AlimentaCollAmbiTot(CollAmbiTot)
	k = 0
	For Each cAmbo In CollAmbiTot
		For Each cEstr In CollEstrazioni
			If cEstr.IsAmboPresente(cAmbo.key) Then
				cAmbo.presenze = cAmbo.presenze + 1
			End If
		Next
		k = k + 1
		Call AvanzamentoElab(1,CollAmbiTot.count,k)
		If ScriptInterrotto Then Exit For
	Next
	Call OrdinaItemCollection(CollAmbiTot,"Presenze","Key")
End Sub
Sub CreaTabCopertura(CollAmbiTot,CollEstrazioni,nRigheMax)
	Dim cAmbo
	Dim k
	Dim cEstr
	Call Scrivi("La seguente tabella indica la copertura degli ambi sulle estrazioni rilevate dai casi (" & CollEstrazioni.count & " casi)")
	Call Scrivi
	' tabella copertura
	ReDim aTitoli(3)
	aTitoli(1) = "Ambo"
	aTitoli(2) = "Estrazioni Coperte"
	aTitoli(3) = "Percentuale"
	Call InitTabella(aTitoli)
	For Each cAmbo In CollAmbiTot
		If cAmbo.presenze > 0 Then
			ReDim aValori(3)
			aValori(1) = cAmbo.NumeriString
			aValori(2) = cAmbo.presenze
			aValori(3) = Round(ProporzioneX(cAmbo.presenze,CollEstrazioni.count,100),3) & " %"
			Call AddRigaTabella(aValori)
		End If
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabPresenze(CollAmbi,nRigheMax)
	Dim cAmbo
	' tabella presenze
	Call Scrivi("La seguente tabella indica la frequenza degli ambi")
	Call Scrivi
	'Call OrdinaItemCollection(CollAmbi,"Presenze")
	ReDim aTitoli(2)
	aTitoli(1) = "Ambo"
	aTitoli(2) = "Presenze"
	Call InitTabella(aTitoli)
	For Each cAmbo In CollAmbi
		ReDim aValori(2)
		aValori(1) = cAmbo.NumeriString
		aValori(2) = cAmbo.presenze
		Call AddRigaTabella(aValori)
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabCasiRilevati(CollEstrazioni,nPuntiDaFare,nColpi,nRuota)
	Dim i,k,n,nPosSpia,nFreq
	Dim cEstr
	' tabella casi rilevati
	Call Scrivi("La seguente tabella indica i casi rilevati (" & CollEstrazioni.count & " casi)")
	Call Scrivi
	Call Messaggio("Riepilogo  casi rilevati")
	ReDim aTitoli(12)
	aTitoli(1) = "Estrazione"
	aTitoli(2) = "Data"
	aTitoli(3) = "I"
	aTitoli(4) = "II"
	aTitoli(5) = "III"
	aTitoli(6) = "IV"
	aTitoli(7) = "V"
	aTitoli(8) = "Ambo Piu Frequente"
	aTitoli(9) = "Presenze"
	aTitoli(10) = "InizioAnalisi"
	aTitoli(11) = "FineAnalisi"
	aTitoli(12) = "EstrazioniSuccessive"
	i = 0
	Call InitTabella(aTitoli)
	For Each cEstr In CollEstrazioni
		ReDim aValori(12)
		aValori(1) = cEstr.idEst
		aValori(2) = DataEstrazione(cEstr.idEst)
		ReDim aPosTrovate(5)
		
		For k = 1 To 5
			n = Estratto(cEstr.idEst,nRuota,k)
			If IsNumeroPresenteInLunghetta(cEstr.anumrilevati,n) Then
				aPosTrovate(k) = True
			End If
			aValori(k + 2) = n
		Next
		aValori(8) = cEstr.GetAmboPiuFreq(nFreq)
		aValori(9) = nFreq
		aValori(10) = cEstr.Inizio
		aValori(11) = cEstr.Fine
		aValori(12) = cEstr.Fine -(cEstr.Inizio - 1)
		ReDim aColori(0)
		Call GetColoriRiga(aColori,aPosTrovate,Iif(aValori(12) = nColpi,vbGreen,vbYellow))
		Call AddRigaTabella(aValori,aColori)
		i = i + 1
		Call AvanzamentoElab(1,CollEstrazioni.count,i)
		If ScriptInterrotto Then Exit For
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella()
End Sub
Function IsNumeroPresenteInLunghetta(aNumDaCercare,n)
	Dim k
	
	For k = 1 To UBound(aNumDaCercare)
		If CInt(aNumDaCercare(k)) = CInt(n) Then
			IsNumeroPresenteInLunghetta = True
			Exit For
		End If
	Next
End Function
'Sub CreaTabRiepilogo(CollAmbi,CollAmbiTot,nCasiTrov,nInizio,nFine,nRuota,nRigheMax)
'	Dim cAmboF,cAmboP
'	Dim i
'
'	Call Messaggio("Tabella riepilogo")
'
'	' tabella presenze
'	Call Scrivi("La seguente tabella indica la frequenza degli ambi e le rispettive presenze")
'	Call Scrivi
'	ReDim aTitoli(8)
'	aTitoli(1) = "Ambo"
'	aTitoli(2) = "Presenze"
'	aTitoli(3) = "Percentuale"
'	aTitoli(4) = "Frequenza"
'	aTitoli(5) = "Freq/Pres"
'	aTitoli(6) = "Ritardo"
'	aTitoli(7) = "RitMax"
'	aTitoli(8) = "Ultima"
'
'	Call InitTabella(aTitoli,vbBlue,,,vbWhite)
'
'	ReDim aColori(8)
'	aColori(1) = vbCyan
'	aColori(2) = vbGreen
'	aColori(3) = vbYellow
'	aColori(4) = vbGreen
'	aColori(5) = RGB(255,100,100)
'	aColori(6) = RGB(255,90,90)
'	aColori(7) = RGB(255,80,80)
'	aColori(8) = RGB(255,70,70)
'
'
'	For Each cAmboF In CollAmbi
'		Set cAmboP = CollAmbiTot(cAmboF.key)
'		Call cAmboF.StatisticaAmbo(nInizio,nFine,nRuota)
'		ReDim aValori(8)
'		aValori(1) = cAmboF.NumeriString
'		aValori(2) = cAmboP.presenze
'		aValori(3) = Round(Dividi((cAmboP.presenze * 100),nCasiTrov),3) & " %"
'		aValori(4) = cAmboF.presenze
'		aValori(5) = Round(Dividi(cAmboF.presenze,cAmboP.presenze),3)
'		aValori(6) = cAmboF.Ritardo
'		aValori(7) = cAmboF.RitardoMax
'		aValori(8) = nFine - cAmboF.ritardo
'
'
'		Call AddRigaTabella(aValori,aColori)
'		i = i + 1
'		Call AvanzamentoElab(1,nRigheMax,i)
'		If ScriptInterrotto Then Exit For
'		If i = nRigheMax Then Exit For
'
'	Next
'	Call Messaggio("Creazione tabella in corso ...")
'	Call CreaTabella(,,,nRigheMax)
'End Sub
Sub CreaTabRiepilogo(CollAmbi,CollAmbiTot,nCasiTrov,nInizio,nFine,nRuota,nRigheMax)
	Dim cAmboF,cAmboP
	Dim i
	Call Messaggio("Tabella riepilogo")
	' tabella presenze
	Call Scrivi("La seguente tabella indica la frequenza degli ambi e le rispettive presenze")
	Call Scrivi
	ReDim aTitoli(8)
	aTitoli(1) = "Ambo"
	aTitoli(2) = "Presenze"
	aTitoli(3) = "Percentuale"
	aTitoli(4) = "Frequenza"
	aTitoli(5) = "Freq/Pres"
	aTitoli(6) = "Ritardo"
	aTitoli(7) = "RitMax"
	aTitoli(8) = "Ultima"
	Call InitTabella(aTitoli,vbBlue,,,vbWhite)
	ReDim aColori(8)
	aColori(1) = vbCyan
	aColori(2) = vbGreen
	aColori(3) = vbYellow
	aColori(4) = vbGreen
	aColori(5) = RGB(255,100,100)
	aColori(6) = RGB(255,90,90)
	aColori(7) = RGB(255,80,80)
	aColori(8) = RGB(255,70,70)
	For Each cAmboP In CollAmbiTot
		Set cAmboF = CollAmbi(cAmboP.key)
		Call cAmboP.StatisticaAmbo(nInizio,nFine,nRuota)
		ReDim aValori(8)
		aValori(1) = cAmboP.NumeriString
		aValori(2) = cAmboP.presenze
		aValori(3) = Round(ProporzioneX(cAmboP.presenze,nCasiTrov,100),3) & " %"
		aValori(4) = cAmboF.presenze
		aValori(5) = Round(Dividi(cAmboF.presenze,cAmboP.presenze),3)
		aValori(6) = cAmboP.Ritardo
		aValori(7) = cAmboP.RitardoMax
		aValori(8) = nFine - cAmboP.ritardo
		Call AddRigaTabella(aValori,aColori)
		i = i + 1
		Call AvanzamentoElab(1,nRigheMax,i)
		If ScriptInterrotto Then Exit For
		If i = nRigheMax Then Exit For
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella()
End Sub

LuigiB · 6 Febbraio 2012

questo script che posto funziona solo con la nuova versione che emttero entro stasera.
E' molto piu articolato del precedente.

Codice:

Option Explicit
Class clsAmbo
	Private aNumeri(2)
	Private m_Presenze
	Private m_Key
	Private m_Ritardo
	Private m_RitardoMax
	Public Property Let Key(v)
		m_Key = v
	End Property
	Public Property Get Key()
		Key = m_Key
	End Property
	Public Property Get Presenze()
		Presenze = m_Presenze
	End Property
	Public Property Let Presenze(v)
		m_Presenze = v
	End Property
	Public Property Get NumeriString
		NumeriString = StringaNumeri(aNumeri,,True)
	End Property
	Public Property Get Ritardo
		Ritardo = m_Ritardo
	End Property
	Public Property Get RitardoMax
		RitardoMax = m_RitardoMax
	End Property
	Sub SetNumero(id,Numero)
		aNumeri(id) = Numero
	End Sub
	Sub StatisticaAmbo(nInizio,nFine,nRuota)
		ReDim aRuota(1)
		aRuota(1) = nRuota
		Call StatisticaFormazione(aNumeri,aRuota,2,m_Ritardo,m_RitardoMax,0,0,nInizio,nFine)
	End Sub
End Class
Class clsEstrazione
	Private m_collAmbi
	Private m_IdEst
	Private m_Inizio
	Private m_Fine
	Private m_aNumRilevati	
	Public Property Get Inizio
		Inizio = m_Inizio
	End Property
	Public Property Let Inizio(v)
		m_Inizio = v
	End Property
	Public Property Get Fine
		Fine = m_Fine
	End Property
	Public Property Let Fine(v)
		m_Fine = v
	End Property
	Public Property Get CollAmbi
		Set CollAmbi = m_collAmbi
	End Property
	Public Property Let IdEst(v)
		m_IdEst = v
	End Property
	Public Property Get IdEst()
		IdEst = m_IdEst
	End Property
	Public Property Let aNumRilevati(v)
	
		m_aNumRilevati = v
	End Property
	Public Property Get aNumRilevati
	
		aNumRilevati = m_aNumRilevati
	End Property
	

	Sub Init(idEstr)
		Set m_collAmbi = GetNewCollection
		m_IdEst = idEstr
		m_Inizio = idEstr + 1
	End Sub
	Sub AddAmbo(aColonne,idColonna)
		Dim cAmbo
		Dim sKey
		sKey = "k" & Format2(aColonne(idColonna,1)) & "-" & Format2(aColonne(idColonna,2))
		Set cAmbo = GetItem(sKey,m_collAmbi)
		If cAmbo Is Nothing Then
			Set cAmbo = New clsAmbo
			Call cAmbo.SetNumero(1,aColonne(idColonna,1))
			Call cAmbo.SetNumero(2,aColonne(idColonna,2))
			cAmbo.Presenze = 1
			cAmbo.key = sKey
			m_collAmbi.Add cAmbo,sKey
		Else
			cAmbo.Presenze = cAmbo.Presenze + 1
		End If
	End Sub
	Function IsAmboPresente(sKey)
		Dim cAmbo
		Set cAmbo = GetItem(sKey,m_collAmbi)
		If Not(cAmbo Is Nothing) Then
			IsAmboPresente = True
		End If
	End Function
	Function GetAmboPiuFreq(nRetFrq)
		Dim cAmbo
		If m_collAmbi.count > 0 Then
			Call OrdinaItemCollection(m_collAmbi,"Presenze")
			Set cAmbo = m_collAmbi(1)
			GetAmboPiuFreq = cAmbo.NumeriString
			nRetFrq = cAmbo.Presenze
		Else
			GetAmboPiuFreq = ""
		End If
	End Function
End Class
Sub Main
	Dim nInizio,nFine,nColpi
	Dim idEstr,k,e,i
	Dim nRuota
	Dim aColonne
	Dim cAmbo,cEstr
	Dim sKey
	Dim CollAmbi
	Dim CollEstrazioni
	Dim CollAmbiTot
	Dim bTrovato
	Dim TipoRicerca
	Dim aElemFormazione
	Const RigheMaxTabAmbiFreq = 20
	Const RigheMaxTabCopertura = 20
	Const RigheMaxRiepilogo = 20
	Dim aNumDaCercare
	Dim nPuntiDaFare
	Dim nClasseFrz
	
	TipoRicerca = GetTipoRicerca
	nColpi = CInt(InputBox("Inserisci colpi",,10))
	nInizio = EstrazioneIni
	nFine = EstrazioneFin
	nRuota = ScegliRuota
	Set CollAmbi = GetNewCollection
	Set CollEstrazioni = GetNewCollection
	Set CollAmbiTot = GetNewCollection
	If TipoRicerca = 0 Then
		' numero spia
		ReDim aNumDaCercare(1)
		aNumDaCercare(1) = CInt(InputBox("Inserisci Numero Spia"))
		nPuntiDaFare = 1
	ElseIf TipoRicerca = 1 Then
		' punti su lunghetta
		Call RichiediLunghetta(aNumDaCercare,nPuntiDaFare)
	ElseIf TipoRicerca = 2 Then
		' punti su elemento formazione
		Call RichiediFormazione(aElemFormazione,nPuntiDaFare,nClasseFrz)
		ReDim aNumDaCercare(nClasseFrz)
	Else
		nPuntiDaFare = 1
		ReDim aNumDaCercare(1)

	End If
	If nColpi > 0 And nRuota > 0 And TipoRicerca >= 0 And nPuntiDaFare > 0 Then
		For idEstr = nInizio To nFine
			'bTrovato = IsNumeroPresenteInEstrazione(idEstr,nRuota,nSpia,0)
			bTrovato = VerificaCondizione(TipoRicerca,idEstr,nRuota,aNumDaCercare,nPuntiDaFare,aElemFormazione)

			If bTrovato Then
				Set cEstr = New clsEstrazione
				Call cEstr.Init(idEstr)
				cEstr.aNumRilevati = aNumDaCercare
				For i = idEstr + 1 To idEstr + nColpi
					ReDim aNum(5)
					Call GetArrayNumeriRuota(i,nRuota,aNum)
					If aNum(1) > 0 Then
						Call OrdinaMatrice(aNum,1)
						aColonne = SviluppoIntegrale(aNum,2)
						For k = 1 To UBound(aColonne)
							Call cEstr.AddAmbo(aColonne,k)
							sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
							Set cAmbo = GetItem(sKey,CollAmbi)
							If cAmbo Is Nothing Then
								Set cAmbo = New clsAmbo
								cAmbo.key = sKey
								Call cAmbo.SetNumero(1,aColonne(k,1))
								Call cAmbo.SetNumero(2,aColonne(k,2))
								cAmbo.Presenze = 1
								CollAmbi.Add cAmbo,sKey
							Else
								cAmbo.Presenze = cAmbo.Presenze + 1
							End If
						Next
					End If
					cEstr.fine = i
					If TipoRicerca < 3 Then
						If VerificaCondizione(TipoRicerca,i,nRuota,aNumDaCercare,nPuntiDaFare,aElemFormazione) Then
							idEstr = i - 1
							Exit For
						End If
					End If
				Next
				CollEstrazioni.Add cEstr,"k" & cEstr.idEst
			End If
			Call AvanzamentoElab(nInizio,nFine,idEstr)
			If ScriptInterrotto Then Exit For
		Next
		Call OrdinaItemCollection(CollAmbi,"Presenze","Key")
		Call CalcolaCopertura(CollAmbiTot,CollEstrazioni)
		Call CreaTabRiepilogo(CollAmbi,CollAmbiTot,CollEstrazioni.count,nInizio,nFine,nRuota,RigheMaxRiepilogo)
		Call CreaTabPresenze(CollAmbi,RigheMaxTabAmbiFreq)
		Call CreaTabCopertura(CollAmbiTot,CollEstrazioni,RigheMaxTabCopertura)
		Call CreaTabCasiRilevati(CollEstrazioni,nPuntiDaFare,nColpi,nRuota)
	End If
End Sub
Function VerificaCondizione(TipoRicerca,idEstr,nRuota,aNumDaCercare,nPuntiDaFare,aElemFormazione)
	Dim bTrovato,k,e
	bTrovato = False
	Select Case TipoRicerca
	Case 0 ' numero spia
		bTrovato = IsNumeroPresenteInEstrazione(idEstr,nRuota,aNumDaCercare(1),0)
	Case 1 ' punti su lunghetta
		ReDim aNum(5)
		Call GetArrayNumeriRuota(idEstr,nRuota,aNum)
		If PuntiSuArray(aNum,aNumDaCercare) >= nPuntiDaFare Then
			bTrovato = True
		End If
	Case 2
		ReDim aNum(5)
		Call GetArrayNumeriRuota(idEstr,nRuota,aNum)
		
		For k = 1 To UBound(aElemFormazione)
			For e = 1 To UBound(aNumDaCercare)
				aNumDaCercare(e) = aElemFormazione(k,e)
			Next
			If PuntiSuArray(aNum,aNumDaCercare) >= nPuntiDaFare Then
				bTrovato = True
				Exit For
			End If

			
		Next
	Case 3 ' prima del mese
		If IndiceMensile(idEstr) = 1 Then
			bTrovato = True
		End If
	Case 4 ' ultima del Mese
		If IsUltimaDelMese(idEstr) Then
			bTrovato = True
		End If

	End Select
	VerificaCondizione = bTrovato
End Function
Function GetTipoRicerca()
	ReDim aVoci(4)
	aVoci(0) = "Numero spia"
	aVoci(1) = "Punti su lunghetta"
	aVoci(2) = "Punti su formazione"
	aVoci(3) = "Prima del mese"
	aVoci(4) = "Ultima del mese"
	
	GetTipoRicerca = ScegliOpzioneMenu(aVoci,0,"Selezione tipo ricerca")
End Function
Sub RichiediLunghetta(aNumDaCercare,nPuntiDaFare)
	Dim s
	Dim n
	s = InputBox("Inserire i numeri della lunghetta separati da , (virgola)",,"1,2,3,4")
	n = CInt(InputBox("Inserire i punti da realizzare sulla lunghetta",,1))
	ReDim aNumDaCercare(0)
	Call SplitByChar("0," & s,",",aNumDaCercare)
	If n > 0 Then
		nPuntiDaFare = n
	End If
End Sub
Sub RichiediFormazione(aElemFormazione,nPuntiDaFare,nClasseFrz)

	Dim s
	Dim n
	Dim id
	
	ReDim aNomiForm(0)
	
	Call ElencoFileInDirectory(GetDirectoryAppData & "formazioni\",aNomiForm,".frz")
	id = ScegliOpzioneMenu(aNomiForm,1,"Selezione formazione")
	
	If GetElementiFormazione(aNomiForm(id),aElemFormazione) Then
	
		n = CInt(InputBox("Inserire i punti da realizzare su un qualsiasi elemento della formazione",,1))
		nClasseFrz = GetClasseFormazione(aNomiForm(id))
	End If
	
	If n > 0 Then
		nPuntiDaFare = n
	End If

End Sub
Function GetItem(sKey,CollAmbi)
	On Error Resume Next
	Set GetItem = Nothing
	Set GetItem = CollAmbi(sKey)
End Function
Sub AlimentaCollAmbiTot(collAmbi)
	Dim k,sKey
	Dim aColonne
	Dim cAmbo
	aColonne = SviluppoIntegrale(GetNumPerSviluppo,2)
	For k = 1 To UBound(aColonne)
		sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
		Set cAmbo = New clsAmbo
		cAmbo.key = sKey
		Call cAmbo.SetNumero(1,aColonne(k,1))
		Call cAmbo.SetNumero(2,aColonne(k,2))
		cAmbo.Presenze = 0
		collAmbi.Add cAmbo,sKey
	Next
End Sub
Sub GetColoriRiga(aColori,aColDaEvid,ColoreLastCol)
	ReDim aColori(12)
	Dim k
	For k = 1 To 12
		aColori(k) = vbWhite
	Next
	For k = 1 To UBound(aColDaEvid)
		If aColDaEvid(k) Then
			aColori(k + 2) = vbYellow
		End If
	Next
	aColori(12) = ColoreLastCol
End Sub
Sub CalcolaCopertura(CollAmbiTot,CollEstrazioni)
	Dim cAmbo
	Dim k
	Dim cEstr
	' tabella copertura
	Call Messaggio("Calcolo copertura estrazioni")
	Call AlimentaCollAmbiTot(CollAmbiTot)
	k = 0
	For Each cAmbo In CollAmbiTot
		For Each cEstr In CollEstrazioni
			If cEstr.IsAmboPresente(cAmbo.key) Then
				cAmbo.presenze = cAmbo.presenze + 1
			End If
		Next
		k = k + 1
		Call AvanzamentoElab(1,CollAmbiTot.count,k)
		If ScriptInterrotto Then Exit For
	Next
	Call OrdinaItemCollection(CollAmbiTot,"Presenze","Key")
End Sub
Sub CreaTabCopertura(CollAmbiTot,CollEstrazioni,nRigheMax)
	Dim cAmbo
	Dim k
	Dim cEstr
	Call Scrivi("La seguente tabella indica la copertura degli ambi sulle estrazioni rilevate dai casi (" & CollEstrazioni.count & " casi)")
	Call Scrivi
	' tabella copertura
	ReDim aTitoli(3)
	aTitoli(1) = "Ambo"
	aTitoli(2) = "Estrazioni Coperte"
	aTitoli(3) = "Percentuale"
	Call InitTabella(aTitoli)
	For Each cAmbo In CollAmbiTot
		If cAmbo.presenze > 0 Then
			ReDim aValori(3)
			aValori(1) = cAmbo.NumeriString
			aValori(2) = cAmbo.presenze
			aValori(3) = Round(ProporzioneX(cAmbo.presenze,CollEstrazioni.count,100),3) & " %"
			Call AddRigaTabella(aValori)
		End If
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabPresenze(CollAmbi,nRigheMax)
	Dim cAmbo
	' tabella presenze
	Call Scrivi("La seguente tabella indica la frequenza degli ambi")
	Call Scrivi
	'Call OrdinaItemCollection(CollAmbi,"Presenze")
	ReDim aTitoli(2)
	aTitoli(1) = "Ambo"
	aTitoli(2) = "Presenze"
	Call InitTabella(aTitoli)
	For Each cAmbo In CollAmbi
		ReDim aValori(2)
		aValori(1) = cAmbo.NumeriString
		aValori(2) = cAmbo.presenze
		Call AddRigaTabella(aValori)
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabCasiRilevati(CollEstrazioni,nPuntiDaFare,nColpi,nRuota)
	Dim i,k,n,nPosSpia,nFreq
	Dim cEstr
	' tabella casi rilevati
	Call Scrivi("La seguente tabella indica i casi rilevati (" & CollEstrazioni.count & " casi)")
	Call Scrivi
	Call Messaggio("Riepilogo  casi rilevati")
	ReDim aTitoli(12)
	aTitoli(1) = "Estrazione"
	aTitoli(2) = "Data"
	aTitoli(3) = "I"
	aTitoli(4) = "II"
	aTitoli(5) = "III"
	aTitoli(6) = "IV"
	aTitoli(7) = "V"
	aTitoli(8) = "Ambo Piu Frequente"
	aTitoli(9) = "Presenze"
	aTitoli(10) = "InizioAnalisi"
	aTitoli(11) = "FineAnalisi"
	aTitoli(12) = "EstrazioniSuccessive"
	i = 0
	Call InitTabella(aTitoli)
	For Each cEstr In CollEstrazioni
		ReDim aValori(12)
		aValori(1) = cEstr.idEst
		aValori(2) = DataEstrazione(cEstr.idEst)
		ReDim aPosTrovate(5)
		
		For k = 1 To 5
			n = Estratto(cEstr.idEst,nRuota,k)
			If IsNumeroPresenteInLunghetta(cEstr.anumrilevati,n) Then
				aPosTrovate(k) = True
			End If
			aValori(k + 2) = n
		Next
		aValori(8) = cEstr.GetAmboPiuFreq(nFreq)
		aValori(9) = nFreq
		aValori(10) = cEstr.Inizio
		aValori(11) = cEstr.Fine
		aValori(12) = cEstr.Fine -(cEstr.Inizio - 1)
		ReDim aColori(0)
		Call GetColoriRiga(aColori,aPosTrovate,Iif(aValori(12) = nColpi,vbGreen,vbYellow))
		Call AddRigaTabella(aValori,aColori)
		i = i + 1
		Call AvanzamentoElab(1,CollEstrazioni.count,i)
		If ScriptInterrotto Then Exit For
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella()
End Sub
Function IsNumeroPresenteInLunghetta(aNumDaCercare,n)
	Dim k
	
	For k = 1 To UBound(aNumDaCercare)
		If CInt(aNumDaCercare(k)) = CInt(n) Then
			IsNumeroPresenteInLunghetta = True
			Exit For
		End If
	Next
End Function
'Sub CreaTabRiepilogo(CollAmbi,CollAmbiTot,nCasiTrov,nInizio,nFine,nRuota,nRigheMax)
'	Dim cAmboF,cAmboP
'	Dim i
'
'	Call Messaggio("Tabella riepilogo")
'
'	' tabella presenze
'	Call Scrivi("La seguente tabella indica la frequenza degli ambi e le rispettive presenze")
'	Call Scrivi
'	ReDim aTitoli(8)
'	aTitoli(1) = "Ambo"
'	aTitoli(2) = "Presenze"
'	aTitoli(3) = "Percentuale"
'	aTitoli(4) = "Frequenza"
'	aTitoli(5) = "Freq/Pres"
'	aTitoli(6) = "Ritardo"
'	aTitoli(7) = "RitMax"
'	aTitoli(8) = "Ultima"
'
'	Call InitTabella(aTitoli,vbBlue,,,vbWhite)
'
'	ReDim aColori(8)
'	aColori(1) = vbCyan
'	aColori(2) = vbGreen
'	aColori(3) = vbYellow
'	aColori(4) = vbGreen
'	aColori(5) = RGB(255,100,100)
'	aColori(6) = RGB(255,90,90)
'	aColori(7) = RGB(255,80,80)
'	aColori(8) = RGB(255,70,70)
'
'
'	For Each cAmboF In CollAmbi
'		Set cAmboP = CollAmbiTot(cAmboF.key)
'		Call cAmboF.StatisticaAmbo(nInizio,nFine,nRuota)
'		ReDim aValori(8)
'		aValori(1) = cAmboF.NumeriString
'		aValori(2) = cAmboP.presenze
'		aValori(3) = Round(Dividi((cAmboP.presenze * 100),nCasiTrov),3) & " %"
'		aValori(4) = cAmboF.presenze
'		aValori(5) = Round(Dividi(cAmboF.presenze,cAmboP.presenze),3)
'		aValori(6) = cAmboF.Ritardo
'		aValori(7) = cAmboF.RitardoMax
'		aValori(8) = nFine - cAmboF.ritardo
'
'
'		Call AddRigaTabella(aValori,aColori)
'		i = i + 1
'		Call AvanzamentoElab(1,nRigheMax,i)
'		If ScriptInterrotto Then Exit For
'		If i = nRigheMax Then Exit For
'
'	Next
'	Call Messaggio("Creazione tabella in corso ...")
'	Call CreaTabella(,,,nRigheMax)
'End Sub
Sub CreaTabRiepilogo(CollAmbi,CollAmbiTot,nCasiTrov,nInizio,nFine,nRuota,nRigheMax)
	Dim cAmboF,cAmboP
	Dim i
	Call Messaggio("Tabella riepilogo")
	' tabella presenze
	Call Scrivi("La seguente tabella indica la frequenza degli ambi e le rispettive presenze")
	Call Scrivi
	ReDim aTitoli(8)
	aTitoli(1) = "Ambo"
	aTitoli(2) = "Presenze"
	aTitoli(3) = "Percentuale"
	aTitoli(4) = "Frequenza"
	aTitoli(5) = "Freq/Pres"
	aTitoli(6) = "Ritardo"
	aTitoli(7) = "RitMax"
	aTitoli(8) = "Ultima"
	Call InitTabella(aTitoli,vbBlue,,,vbWhite)
	ReDim aColori(8)
	aColori(1) = vbCyan
	aColori(2) = vbGreen
	aColori(3) = vbYellow
	aColori(4) = vbGreen
	aColori(5) = RGB(255,100,100)
	aColori(6) = RGB(255,90,90)
	aColori(7) = RGB(255,80,80)
	aColori(8) = RGB(255,70,70)
	For Each cAmboP In CollAmbiTot
		Set cAmboF = CollAmbi(cAmboP.key)
		Call cAmboP.StatisticaAmbo(nInizio,nFine,nRuota)
		ReDim aValori(8)
		aValori(1) = cAmboP.NumeriString
		aValori(2) = cAmboP.presenze
		aValori(3) = Round(ProporzioneX(cAmboP.presenze,nCasiTrov,100),3) & " %"
		aValori(4) = cAmboF.presenze
		aValori(5) = Round(Dividi(cAmboF.presenze,cAmboP.presenze),3)
		aValori(6) = cAmboP.Ritardo
		aValori(7) = cAmboP.RitardoMax
		aValori(8) = nFine - cAmboP.ritardo
		Call AddRigaTabella(aValori,aColori)
		i = i + 1
		Call AvanzamentoElab(1,nRigheMax,i)
		If ScriptInterrotto Then Exit For
		If i = nRigheMax Then Exit For
	Next
	Call Messaggio("Creazione tabella in corso ...")
	Call CreaTabella()
End Sub

keeper · 6 Febbraio 2012

Se metti la nuova cversione puoi cambiare il rollbar delle estrazioni?

Per Luigi -- funzione SerieFreq

Premium Member

LuigiB

Guest

Premium Member

Roby

Guest

Roby

Guest

Super Member >PLATINUM<

Premium Member

Premium Member

Super Member >PLATINUM<

LuigiB

Guest

Roby

Guest

Premium Member

Premium Member

Super Member >PLATINUM<

Super Member >PLATINUM<

Super Member >PLATINUM<

Roby

Guest

LuigiB

Guest

LuigiB

Guest

Advanced Member >PLATINUM PLUS<