Novità

Listato 10elotto trova frequenza da modificare

solare

Advanced Member >PLATINUM<
Chiedo cortesemente una modifica a questo listato fatto dal gentilissimo Luigi.
La modifica consiste nel far elaborare no le ultime 18 estrazioni ma cicli da 10 estrazioni.
Sub Main
Dim TipoArc
Dim nCicli
Dim Inizio,Fine
Dim idEstr
Dim idDecina
Dim sErr
Dim nTotale
ReDim aNum(10)
ReDim aRuote(1)



nCicli = Int(InputBox("Inserire il numero dei cicli da 18",,10))
TipoArc = ScegliArchivio
Inizio =(EstrazioniArchivioDL -(nCicli * 18)) + 1
Fine = EstrazioniArchivioDL - 17



If nCicli > 0 And Inizio > 0 And TipoArc > 0 Then

Call ImpostaArchivio10ELotto(TipoArc)

For idDecina = 1 To 9
nTotale = 0
Call AlimentaNumeri(idDecina,aNum)
ReDim aTitoli(2)
aTitoli(1) = " Range "
aTitoli(2) = " Frequenza "
Call InitTabella(aTitoli)
For idEstr = Inizio To Fine Step 18
ReDim aValori(2)
aValori(1) = CStr(idEstr) & " - " & CStr(idEstr + 17)
aValori(2) = SerieFreqDL(idEstr,idEstr + 17,aNum,1)
nTotale = nTotale + CLng(aValori(2))
Call AddRigaTabella(aValori)
Next
ReDim aValori(2)
aValori(1) = "Totale"
aValori(2) = nTotale
Call AddRigaTabella(aValori,vbYellow)


Call Scrivi("Decina analizzata " & StringaNumeri(aNum))

Call Scrivi

Call CreaTabella
Next
Else
If nCicli <= 0 Then
sErr = "Numero di cicli non valido"
End If
If Inizio <= 0 Then
sErr = "Troppi cicli rispetto alle estrazioni del range"
End If
If idDecina <= 0 Then
sErr = "Nessuna decina selezionata"
End If
If TipoArc <= 0 Then
sErr = "Specificare quale archivio 10 e lotto"
End If


MsgBox sErr,vbCritical
End If
End Sub
Function ScegliDecina()
ReDim aVoci(8)
Dim k,i
For k = 1 To 81 Step 10
aVoci(i) = "Decina " & k & " - " & k + 9
i = i + 1
Next
ScegliDecina = ScegliOpzioneMenu(aVoci,0,"Selezione decina") + 1
End Function
Sub AlimentaNumeri(idDecina,aNum)
Dim i,k,y
i =((idDecina - 1) * 10) + 1
For k = i To(i - 1) + 10
y = y + 1
aNum(y) = k
Next
End Sub
Function ScegliArchivio()

ReDim aVoci(1)

aVoci(0) = "Dieci e lotto"
aVoci(1) = "Dieci e lotto 5 min"


ScegliArchivio = ScegliOpzioneMenu(aVoci,0,"Selezione archivio") + 1
End Function
 
Solare in attesa di luigi se non mi è scappato qualche codice vedi un po la modifica commentata se è giusta.

Mike58

Sub Main
Dim TipoArc
Dim nCicli
Dim Inizio,Fine
Dim idEstr
Dim idDecina
Dim sErr
Dim nTotale
ReDim aNum(10)
ReDim aRuote(1)



nCicli = Int(InputBox("Inserire il numero dei cicli da 10",,10)) ' modifica input box da 18 a 10
TipoArc = ScegliArchivio
Inizio =(EstrazioniArchivioDL -(nCicli * 10)) + 1 ' modifica 18 a 10
Fine = EstrazioniArchivioDL - 9 ' modifiac da 17 a 9



If nCicli > 0 And Inizio > 0 And TipoArc > 0 Then

Call ImpostaArchivio10ELotto(TipoArc)

For idDecina = 1 To 9
nTotale = 0
Call AlimentaNumeri(idDecina,aNum)
ReDim aTitoli(2)
aTitoli(1) = " Range "
aTitoli(2) = " Frequenza "
Call InitTabella(aTitoli)
For idEstr = Inizio To Fine Step 10 ' modifica step da 18 a 10
ReDim aValori(2)
aValori(1) = CStr(idEstr) & " - " & CStr(idEstr + 9) ' modifica da 17 a 9
aValori(2) = SerieFreqDL(idEstr,idEstr + 9,aNum,1)' modifica da 17 a 9
nTotale = nTotale + CLng(aValori(2))
Call AddRigaTabella(aValori)
Next
ReDim aValori(2)
aValori(1) = "Totale"
aValori(2) = nTotale
Call AddRigaTabella(aValori,vbYellow)


Call Scrivi("Decina analizzata " & StringaNumeri(aNum))

Call Scrivi

Call CreaTabella
Next
Else
If nCicli <= 0 Then
sErr = "Numero di cicli non valido"
End If
If Inizio <= 0 Then
sErr = "Troppi cicli rispetto alle estrazioni del range"
End If
If idDecina <= 0 Then
sErr = "Nessuna decina selezionata"
End If
If TipoArc <= 0 Then
sErr = "Specificare quale archivio 10 e lotto"
End If


MsgBox sErr,vbCritical
End If
End Sub
Function ScegliDecina()
ReDim aVoci(8)
Dim k,i
For k = 1 To 81 Step 10
aVoci(i) = "Decina " & k & " - " & k + 9
i = i + 1
Next
ScegliDecina = ScegliOpzioneMenu(aVoci,0,"Selezione decina") + 1
End Function
Sub AlimentaNumeri(idDecina,aNum)
Dim i,k,y
i =((idDecina - 1) * 10) + 1
For k = i To(i - 1) + 10
y = y + 1
aNum(y) = k
Next
End Sub
Function ScegliArchivio()

ReDim aVoci(1)

aVoci(0) = "Dieci e lotto"
aVoci(1) = "Dieci e lotto 5 min"


ScegliArchivio = ScegliOpzioneMenu(aVoci,0,"Selezione archivio") + 1
End Function
 
Grazie intanto per la tua disponibilità.
"10elotto ogni 5 minuti"qualcosa non funziona in quanto ho effettuato a mano il controllo della frequenza relativa alla 71...80 con risultato "frequenza 21" dall'estrazione 131 alla 140 di oggi
mentre il listato da frequenza 28.
Ciao
 
Ciao Solare, sicuramente hai già controllato gli archivi del 10 e lotto 5 min. e non saprei dire perchè ti trovi dei risultati che non ti tornano, io ti posso dire che la riga interessata per il calcolo della frequenza sono queste due righe

aValori(1) = CStr(idEstr) & " - " & CStr(idEstr + 9) ' modifica da 17 a 9
aValori(2) = SerieFreqDL(idEstr,idEstr + 9,aNum,1)' modifica da 17 a 9

---------------------------
dove in avalori(1) identifica il range di 10 estrazioni
e in avalori(2) c'è la seriefrequenza dei numeri con idestr(inizio),idestr(inizio+9),1= ambata.

vedi se ci può essere altro che mi può sfuggire.

Ciao Mike58
 
scusate ragazzi se mi intrometto stavo leggendo il vostro post
se volete vi semplifico il tutto
penso che avete tutti il meraviglioso programma spaziometria
da qui basta che vi applichiate un pochettino e avrete tutte le risposte,da qui potette fare moltissime cose basta fare dei piccoli raggionamenti su quello che si vuol fare
se vi serve qualche delucidazione basta chiedere
saluti giuseppe


[8D][8D][8D]
 
Perchè non dai la risposta ? se sei riuscito a capire il problema.
Non mi pare un modo giusto di intervenire.[:0]

Mike58
 
ciao mike non volevo offendere nessuno dicevo solo che con il programma spaziometria puoi fare la ricerca direttamente da li
 
Ciao vidoque, non volevi ma ci sei andato vicino, qui si sta parlando di capire i codici vbscript e anche dagli errori o dal solo mettersi a capire il ragionamento dei codici vbscript stilati con l'impostazioni di altri non è una cosa semplice.

Comunque non si può intervenire cosi come hai fatto tu!! però nessun problema.

VISTO che sono qui a scrivere per Solare non so se un altra riga incriminata per il tuo risultato potrebbe essere ma non sono sicuro
questa

Fine = EstrazioniArchivioDL-9 'modifica da 17 a 9
fa il controllo dell'archivio fine-9

-------- aggiungo altra modifica script x controllo freq x 2,3,4 numeri.---------

Sub Main
Dim TipoArc
Dim nCicli
Dim Inizio,Fine
Dim idEstr
Dim idDecina
Dim sErr
Dim nTotale,ntotali1,ntotali2,ntotali3

ReDim aNum(10)
ReDim aRuote(1)



nCicli = Int(InputBox("Inserire il numero dei cicli da 10",,10)) ' modifica input box da 18 a 10
TipoArc = ScegliArchivio
Inizio =(EstrazioniArchivioDL -(nCicli * 10)) + 1 ' modifica 18 a 10
Fine = EstrazioniArchivioDL-9 ' modifiac da 17 a 9



If nCicli > 0 And Inizio > 0 And TipoArc > 0 Then

Call ImpostaArchivio10ELotto(TipoArc)

For idDecina = 1 To 9
nTotale = 0
ntotali1 = 0
ntotali2 = 0
ntotali3 = 0


Call AlimentaNumeri(idDecina,aNum)
ReDim aTitoli(5)
aTitoli(1) = " Range "
aTitoli(2) = " Frequenza x 1 "
aTitoli(3) = " Frequenza x 2 "
aTitoli(4) = " Frequenza x 3 "
aTitoli(5) = " Frequenza x 4 "

Call InitTabella(aTitoli)
For idEstr = Inizio To Fine Step 10 ' modifica step da 18 a 10
ReDim aValori(5)
aValori(1) = CStr(idEstr) & " - " & CStr(idEstr + 9) ' modifica da 17 a 9
aValori(2) = SerieFreqDL(idEstr,idEstr + 9,aNum,1)' modifica da 17 a 9
aValori(3) = SerieFreqDL(idEstr,idEstr + 9,aNum,2)' modifica da 17 a 9
aValori(4) = SerieFreqDL(idEstr,idEstr + 9,aNum,3)' modifica da 17 a 9
aValori(5) = SerieFreqDL(idEstr,idEstr + 9,aNum,4)' modifica da 17 a 9

nTotale = nTotale + CLng(aValori(2))
ntotali1 = ntotali1 + CLng(aValori(3))
ntotali2 = ntotali2 + CLng(aValori(4))
ntotali3 = ntotali3 + CLng(aValori(5))

Call AddRigaTabella(aValori)
Next
ReDim aValori(5)
aValori(1) = "Totale"
aValori(2) = nTotale
aValori(3) = ntotali1
aValori(4) = ntotali2
aValori(5) = ntotali3


Call AddRigaTabella(aValori,vbYellow)


Call Scrivi("Decina analizzata " & StringaNumeri(aNum))

Call Scrivi

Call CreaTabella
Next
Else
If nCicli <= 0 Then
sErr = "Numero di cicli non valido"
End If
If Inizio <= 0 Then
sErr = "Troppi cicli rispetto alle estrazioni del range"
End If
If idDecina <= 0 Then
sErr = "Nessuna decina selezionata"
End If
If TipoArc <= 0 Then
sErr = "Specificare quale archivio 10 e lotto"
End If


MsgBox sErr,vbCritical
End If
End Sub
Function ScegliDecina()
ReDim aVoci(8)
Dim k,i
For k = 1 To 81 Step 10
aVoci(i) = "Decina " & k & " - " & k + 9
i = i + 1
Next
ScegliDecina = ScegliOpzioneMenu(aVoci,0,"Selezione decina") + 1
End Function
Sub AlimentaNumeri(idDecina,aNum)
Dim i,k,y
i =((idDecina - 1) * 10) + 1
For k = i To(i - 1) + 10
y = y + 1
aNum(y) = k
Next
End Sub
Function ScegliArchivio()

ReDim aVoci(1)

aVoci(0) = "Dieci e lotto"
aVoci(1) = "Dieci e lotto 5 min"


ScegliArchivio = ScegliOpzioneMenu(aVoci,0,"Selezione archivio") + 1
End Function
 
Grazie del vosto intervento
comunque ho notato che ogni qualvolta si aggiunge una estrazione non cambia il range del listato, quindi qualcosa non va...
ecco perchè i dati non coincidono con quelli fatti a mano.
 
Grazie Mike58, però continuando con l'aggiornamento delle estrazioni il range riportato nel output del listato non cambia quindi resta bloccato e di conseguenza i dati non cambiano.
 
Lo script fa il controllo a step di 10 estrazioni e dovrebbe cambiare il risultato di tutti i range ogni volta che che si aggiunge una estrazione.
PROVA A CORREGGERE L'ultima istruzione che ti ho suggerito ma nel caso ci sarebbe da reimpostare tutto lo script, fammi capire meglio cosa vuoi ottenere.

Adesso aggiorno il 10 e lotto 5min e verifico.
Ciao Mike58
 
Grazie mike58, quello che voglio ottenere da questa ricerca è conoscere le frequenze dei numeri in blocchi da 10 estrazioni
naturalmente per decine naturali 1..10/ 11/20 ecc.
Ciao
 
Solare e quello che avevo capito ed in questo lo script dovrebbe fare quello che richiedi provo a capirci con calma qualche cosa in più.
MAGARI passa Luigi ed al volo risolve l'enigma per adesso mi fermo qui.

Ciao
Mike58
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 22 luglio 2025
    Bari
    29
    03
    79
    27
    86
    Cagliari
    22
    54
    55
    50
    29
    Firenze
    52
    38
    30
    29
    83
    Genova
    08
    62
    20
    69
    26
    Milano
    17
    45
    55
    67
    73
    Napoli
    64
    39
    35
    62
    02
    Palermo
    84
    33
    60
    43
    28
    Roma
    33
    79
    27
    41
    81
    Torino
    35
    58
    38
    70
    56
    Venezia
    64
    11
    07
    57
    27
    Nazionale
    53
    15
    38
    52
    66
    Estrazione Simbolotto
    Nazionale
    18
    24
    03
    21
    15
Indietro
Alto