Novità

Script 10L5min

  • Creatore Discussione Creatore Discussione Y10
  • Data di inizio Data di inizio

Y10

Advanced Member >PLATINUM<
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
 
Ultima modifica:
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
 
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.
 
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"
 
Ciao Moro_80 ho messo la data del 06/10/2014 come data finale e adesso mi funziona.
Prima era al 07/10/2014.
 

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 17 luglio 2025
    Bari
    22
    33
    04
    68
    47
    Cagliari
    09
    52
    27
    21
    47
    Firenze
    05
    33
    72
    17
    08
    Genova
    76
    67
    65
    68
    45
    Milano
    75
    52
    46
    34
    22
    Napoli
    40
    23
    71
    12
    22
    Palermo
    44
    89
    39
    01
    31
    Roma
    89
    04
    05
    82
    26
    Torino
    05
    59
    85
    88
    24
    Venezia
    69
    45
    75
    44
    30
    Nazionale
    28
    85
    16
    03
    83
    Estrazione Simbolotto
    Nazionale
    39
    26
    40
    23
    24

Ultimi Messaggi

Indietro
Alto