Script 10L5min

Y10 · 25 Agosto 2014

Salve , questo era uno script di Luigib , il problema è che era stato fatto quando le estrazioni erano di meno , non vorrei che il calcolo influisse sui risultati . Qualcuno è in grado di correggerlo a 288 estrazioni ?. Grazie

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

Option Explicit

Dim collPresenze

Class clsFormazione
Public nPresenze
Public sNumeri

End Class

Sub Main
Dim nEstrInizio,nEstrFine
Dim DataIni,DataFin
Dim FasciaOrariaIni,FasciaOrariaFin
Dim sOraIni,sOraFin
Dim quantitaFrz
Dim nClasse
Dim nEstrEsam,nEstrValide,nEstrNonValide

Call ImpostaArchivio10ELotto(2)
quantitaFrz = 10

If ChiediDataInizioFine(DataIni,DataFin,10) Then
If ChiediFasciaInizioFine(FasciaOrariaIni,FasciaOrariaFin,sOraIni,sOraFin) Then
If ChiediClasse(nClasse) Then
nEstrInizio = DataEstrToIdEstrDL(Day(DataIni),Month(DataIni),Year(DataIni),1)
nEstrFine = DataEstrToIdEstrDL(Day(DataFin),Month(DataFin),Year(DataFin),1)
If IsRangeValido(nEstrInizio,nEstrFine) Then
Call EseguiStatistica(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,nClasse,nEstrEsam,nEstrValide,nEstrNonValide)
Call ScriviParametriRicerca(DataIni,DataFin,sOraIni,sOraFin,nEstrEsam,nEstrValide,nEstrNonValide,quantitaFrz,nClasse)
Call MostraFormazioniPiuFre(quantitaFrz)

End If
End If
End If
End If
End Sub
Sub ScriviParametriRicerca(DataI,DataF,OraI,OraF,EstrEsam,Valide,NonValide,QuantitaFrz,nClasse)

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

End Sub
Sub MostraFormazioniPiuFre(Quantita)

Dim clsFrz
Dim k,y
Dim idFrz
ReDim aIdFrzScelte(Quantita,1)

For Each clsFrz In collPresenze
idFrz = idFrz + 1
For k = 1 To Quantita
If clsFrz.nPresenze >= aIdFrzScelte(k,0) Then
For y = Quantita To(k + 1) Step - 1
aIdFrzScelte(y,0) = aIdFrzScelte(y - 1,0)
aIdFrzScelte(y,1) = aIdFrzScelte(y - 1,1)
Next
aIdFrzScelte(k,0) = clsFrz.nPresenze
aIdFrzScelte(k,1) = idFrz
Exit For
End If
Next
Next

ReDim aV(2)
aV(1) = "Formazione"
aV(2) = "Presenze"

InitTabella(aV)
For k = 1 To Quantita
Set clsFrz = collPresenze(aIdFrzScelte(k,1))
aV(1) = clsFrz.sNumeri
aV(2) = clsFrz.nPresenze
Call AddRigaTabella(aV)
Next

Call CreaTabella

End Sub

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

Dim k,f,idEstr

nEstrEsaminateTot = 0
nEstrValide = 0
nEstrNonValide = 0

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

Next
If ScriptInterrotto Then Exit For

Next
End Sub
Sub InserisciForrmazioniInColl(aNumeri,nClasse)
Dim k,sKey
Dim nColonneTot
Dim aCol
Dim clsFrz
Dim sColonna

'inizializza lo sviluppo
nColonneTot = InitSviluppoIntegrale(aNumeri,nClasse)
k = 0

' ciclo che continua fino a quando le colonne non finiscono
Do While GetCombSviluppo(aCol)

k = k + 1 ' conteggio colonna corrente

' costruisco la stringa che contiene la colonna
sColonna = StringaNumeri(aCol)
sKey = "K" & sColonna

If GetItemInColl(sKey,clsFrz) Then
clsFrz.nPresenze = clsFrz.nPresenze + 1
Else
Set clsFrz = New clsFormazione
clsFrz.sNumeri = sColonna
clsFrz.nPresenze = 1

Call collPresenze.Add(clsFrz,sKey)
End If

If k Mod 100 = 0 Then
DoEventsEx
Call AvanzamentoElab(0,nColonneTot,k)
If ScriptInterrotto Then Exit Do
End If
Loop
Call AvanzamentoElab(0,nColonneTot,k)

End Sub
Function GetItemInColl(sKey,cls)
On Error Resume Next

Set cls = collPresenze(sKey)

If Err.number <> 0 Then
Set cls = Nothing
GetItemInColl = False
Else
GetItemInColl = True

End If

End Function
Function IsRangeValido(Inizio,Fine)
Dim b
b = False
If Inizio > 0 And Fine > 0 Then
If Fine >= Inizio Then
b = True
End If
End If
If Not b Then

MsgBox "Range non valido , probabilemente mancano le estrazioni nella base dati " & _
vbCrLf & "EstrazioneIni : " & Inizio & vbCrLf & "EstrazioneFine : " & Fine

End If
IsRangeValido = b
End Function
Function ChiediDataInizioFine(DataI,DataF,GiorniDaAnalizzare)
If Not IsDate(DataF) Then DataF = FormattaStringa(Now,"dd/mm/yyyy")
If Not IsDate(DataI) Then DataI = FormattaStringa(DateAdd("d",-(GiorniDaAnalizzare),DataF),"dd/mm/yyyy")
DataI = InputBox("Inserire data inizio ricerca in formato GG/MM/AAAA","Data inizio",DataI)
DataF = InputBox("Inserire data fine ricerca in formato GG/MM/AAAA","Data fine",DataF)
If IsDate(DataI) And IsDate(DataF) Then

If DateDiff("d",DataI,DataF) >= 0 Then
ChiediDataInizioFine = True
Else
MsgBox "La data FINE deve essere maggiore od uguale alla data INIZIO"
End If
Else
MsgBox "Date inserite non valide"
End If
End Function
Function ChiediFasciaInizioFine(FasciaI,FasciaF,sOraIni,sOraFin)

FasciaI = ChiediFasciaOraria("Fascia oraria inizio",sOraIni)
FasciaF = ChiediFasciaOraria("Fascia oraria fine",sOraFin)

If FasciaI > 0 And FasciaF > 0 Then
If FasciaF >= FasciaI Then

ChiediFasciaInizioFine = True
Else
MsgBox "La fascia oraria Fine deve essere maggiore della fascia oraria INIZIO"
End If
Else
MsgBox "Fascie orarie non valide"
End If
End Function

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

Function ChiediClasse(nClasse)

ReDim aVoci(3)
aVoci(1) = "Estratto"
aVoci(2) = "Ambo"
aVoci(3) = "Terno"

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

pescespada37 · 25 Agosto 2014

ciauz Y10, vedi che così già non funziona

Y10 · 25 Agosto 2014

pescespada37 ha scritto:
ciauz Y10, vedi che così già non funziona

Ciao pescespada spiegati meglio , a me funziona benissimo solo che manca il range dalle 24 alle 5 del mattino.

Moro_80 · 25 Agosto 2014

Ciao Y10,

prova con questo, vedi se è quello che voleVi...

Ciao.

Codice:

Option Explicit

Dim collPresenze

Class clsFormazione
Public nPresenze
Public sNumeri


End Class

Sub Main
Dim nEstrInizio,nEstrFine
Dim DataIni,DataFin
Dim FasciaOrariaIni,FasciaOrariaFin
Dim sOraIni,sOraFin
Dim quantitaFrz
Dim nClasse
Dim nEstrEsam,nEstrValide,nEstrNonValide

Call ImpostaArchivio10ELotto(2)
quantitaFrz = 10


If ChiediDataInizioFine(DataIni,DataFin,10) Then
If ChiediFasciaInizioFine(FasciaOrariaIni,FasciaOrariaFin,sOraIni,sOraFin) Then
If ChiediClasse(nClasse) Then
nEstrInizio = DataEstrToIdEstrDL(Day(DataIni),Month(DataIni),Year(DataIni),1)
nEstrFine = DataEstrToIdEstrDL(Day(DataFin),Month(DataFin),Year(DataFin),1)
If IsRangeValido(nEstrInizio,nEstrFine) Then
Call EseguiStatistica(nEstrInizio,nEstrFine,FasciaOrariaIni,FasciaOrariaFin,nClasse,nEstrEsam,nEstrValide ,nEstrNonValide)
Call ScriviParametriRicerca(DataIni,DataFin,sOraIni,sOraFin,nEstrEsam,nEstrValide,nEstrNonValide,quantitaFrz,nClasse)
Call MostraFormazioniPiuFre(quantitaFrz)

End If
End If
End If
End If
End Sub
Sub ScriviParametriRicerca(DataI,DataF,OraI,OraF,EstrEsam,Valide,NonValide,QuantitaFrz,nClasse)

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



End Sub
Sub MostraFormazioniPiuFre(Quantita)

Dim clsFrz
Dim k,y
Dim idFrz
ReDim aIdFrzScelte(Quantita,1)

For Each clsFrz In collPresenze
idFrz = idFrz + 1
For k = 1 To Quantita
If clsFrz.nPresenze >= aIdFrzScelte(k,0) Then
For y = Quantita To(k + 1) Step - 1
aIdFrzScelte(y,0) = aIdFrzScelte(y - 1,0)
aIdFrzScelte(y,1) = aIdFrzScelte(y - 1,1)
Next
aIdFrzScelte(k,0) = clsFrz.nPresenze
aIdFrzScelte(k,1) = idFrz
Exit For
End If
Next
Next

ReDim aV(2)
aV(1) = "Formazione"
aV(2) = "Presenze"

InitTabella(aV)
For k = 1 To Quantita
Set clsFrz = collPresenze(aIdFrzScelte(k,1))
aV(1) = clsFrz.sNumeri
aV(2) = clsFrz.nPresenze
Call AddRigaTabella(aV)
Next

Call CreaTabella


End Sub

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

Dim k,f,idEstr


nEstrEsaminateTot = 0
nEstrValide = 0
nEstrNonValide = 0



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

Next
If ScriptInterrotto Then Exit For

Next
End Sub
Sub InserisciForrmazioniInColl(aNumeri,nClasse)
Dim k,sKey
Dim nColonneTot
Dim aCol
Dim clsFrz
Dim sColonna

'inizializza lo sviluppo
nColonneTot = InitSviluppoIntegrale(aNumeri,nClasse)
k = 0

' ciclo che continua fino a quando le colonne non finiscono
Do While GetCombSviluppo(aCol)

k = k + 1 ' conteggio colonna corrente

' costruisco la stringa che contiene la colonna
sColonna = StringaNumeri(aCol)
sKey = "K" & sColonna

If GetItemInColl(sKey,clsFrz) Then
clsFrz.nPresenze = clsFrz.nPresenze + 1
Else
Set clsFrz = New clsFormazione
clsFrz.sNumeri = sColonna
clsFrz.nPresenze = 1

Call collPresenze.Add(clsFrz,sKey)
End If

If k Mod 100 = 0 Then
DoEventsEx
Call AvanzamentoElab(0,nColonneTot,k)
If ScriptInterrotto Then Exit Do
End If
Loop
Call AvanzamentoElab(0,nColonneTot,k)

End Sub
Function GetItemInColl(sKey,cls)
On Error Resume Next

Set cls = collPresenze(sKey)

If Err.number <> 0 Then
Set cls = Nothing
GetItemInColl = False
Else
GetItemInColl = True

End If

End Function
Function IsRangeValido(Inizio,Fine)
Dim b
b = False
If Inizio > 0 And Fine > 0 Then
If Fine >= Inizio Then
b = True
End If
End If
If Not b Then

MsgBox "Range non valido , probabilemente mancano le estrazioni nella base dati " & _
vbCrLf & "EstrazioneIni : " & Inizio & vbCrLf & "EstrazioneFine : " & Fine


End If
IsRangeValido = b
End Function
Function ChiediDataInizioFine(DataI,DataF,GiorniDaAnalizzare)
If Not IsDate(DataF) Then DataF = FormattaStringa(Now,"dd/mm/yyyy")
If Not IsDate(DataI) Then DataI = FormattaStringa(DateAdd("d",-(GiorniDaAnalizzare),DataF),"dd/mm/yyyy")
DataI = InputBox("Inserire data inizio ricerca in formato GG/MM/AAAA","Data inizio",DataI)
DataF = InputBox("Inserire data fine ricerca in formato GG/MM/AAAA","Data fine",DataF)
If IsDate(DataI) And IsDate(DataF) Then

If DateDiff("d",DataI,DataF) >= 0 Then
ChiediDataInizioFine = True
Else
MsgBox "La data FINE deve essere maggiore od uguale alla data INIZIO"
End If
Else
MsgBox "Date inserite non valide"
End If
End Function
Function ChiediFasciaInizioFine(FasciaI,FasciaF,sOraIni,sOraFin)

FasciaI = ChiediFasciaOraria("Fascia oraria inizio",sOraIni)
FasciaF = ChiediFasciaOraria("Fascia oraria fine",sOraFin)

If FasciaI > 0 And FasciaF > 0 Then
If FasciaF >= FasciaI Then

ChiediFasciaInizioFine = True
Else
MsgBox "La fascia oraria Fine deve essere maggiore della fascia oraria INIZIO"
End If
Else
MsgBox "Fascie orarie non valide"
End If
End Function

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

Function ChiediClasse(nClasse)


ReDim aVoci(3)
aVoci(1) = "Estratto"
aVoci(2) = "Ambo"
aVoci(3) = "Terno"

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

claudio8 · 26 Agosto 2014

pescespada37 ha scritto:
ciauz Y10, vedi che così già non funziona

anche a me......

Y10 · 26 Agosto 2014

Ciao Moro , era proprio ciò che volevo , ti ringrazio , e un ulteriore grazie per il tuo capolavoro di aggiornamento fatto con le "strigliate" di Luigib.

jure · 7 Ottobre 2014

Fino a qualche giorno fa lo script di Moro_80 mi funzionava bene
adesso mi dice errore di run-time di Microsoft VB Script.
linea " IF aNum (1) > 0 then"

Moro_80 · 7 Ottobre 2014

Ciao Jure,
provato un minuto fa e funziona perfettamente...

Ciao

jure · 7 Ottobre 2014

Ciao Moro_80 ho messo la data del 06/10/2014 come data finale e adesso mi funziona.
Prima era al 07/10/2014.

Moro_80 · 7 Ottobre 2014

Ottimo!

Cerca

Cerca

Script 10L5min

Y10

Advanced Member >PLATINUM<

pescespada37

Junior Member

Y10

Advanced Member >PLATINUM<

Moro_80

Advanced Member

claudio8

Premium Member

Y10

Advanced Member >PLATINUM<

jure

Advanced Member >PLATINUM PLUS<

Moro_80

Advanced Member

jure

Advanced Member >PLATINUM PLUS<

Moro_80

Advanced Member

Ultima estrazione Lotto

Ultimi Messaggi