Listato 10elotto trova frequenza da modificare

[solare]

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 = 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

 

[imported_n/a]

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 = 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]

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

 

[imported_n/a]

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

 

[vidoque]

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]

 

[imported_n/a]

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

Mike58

 

[vidoque]

ciao mike non volevo offendere nessuno dicevo solo che con il programma spaziometria puoi fare la ricerca direttamente da li

 

[imported_n/a]

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 = 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]

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.

 

[solare]

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.

 

[imported_n/a]

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

 

[solare]

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

 

[imported_n/a]

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