Listato 10elotto

[solare]

Ciao chiedo cortesemente se è possibile modificare questo listato che possa funzionare anche per il 10elotto ogni 5 minuti.

Option Explicit
Sub Main


Dim nClasse
Dim nGaranzia
Dim k,j
Dim sNumeri
Dim idComb
Dim nInizio,nFine
Dim idValoreDaAna
Dim sValoreUsato
Dim CombTot

ReDim aCombMigliori(100,4)

nClasse = ScegliClasse
nGaranzia = ScegliGaranzia
idValoreDaAna = ScegliValoreDaAnalizzare(sValoreUsato)



nInizio = EstrazioneIni
nFine = EstrazioneFin


If nClasse > 0 And nGaranzia > 0 And nGaranzia <= nClasse And idValoreDaAna > 0 Then
Call Messaggio("Sviluppo combinazioni di classe " & nClasse)
CombTot = InitSviluppaComb(nClasse)

Call Messaggio("Statistica combinazioni in corso ")
ReDim aCol(nClasse)
Do While GetCombSviluppo(aCol) = True
Call AnalisiComb(aCol,nGaranzia,aCombMigliori,nInizio,nFine,idValoreDaAna)
k = k + 1
If k Mod 20 = 0 Then
Call Messaggio("Statistica combinazioni in corso " & k & " di " & CombTot)

Call AvanzamentoElab(1,CombTot,k)

If ScriptInterrotto Then Exit Do
End If
Loop
Call Messaggio("")

ReDim aTitoli(4)
aTitoli(1) = "Combinazione"
aTitoli(2) = "Frequenza"
aTitoli(3) = "Ritardo"
aTitoli(4) = "RitardoMax"


Call Scrivi("Combinazioni di classe " & nClasse & " analizzate per punti " & nGaranzia)
Call Scrivi("La seguente lista mostra le prime 100 combinazioni in base al valore di " & sValoreUsato)
Call Scrivi("Range analizzato " & GetInfoEstrazioneDL(nInizio) & " fino a " & GetInfoEstrazioneDL(nFine))
Call Scrivi("Estrazioni analizzate totali : " &(nFine + 1) - nInizio)
Call Scrivi



Call InitTabella(aTitoli)

For k = 1 To UBound(aCombMigliori)


ReDim ADati(4)
ADati(1) = aCombMigliori(k,4)
ADati(2) = aCombMigliori(k,1)
ADati(3) = aCombMigliori(k,2)
ADati(4) = aCombMigliori(k,3)

Call AddRigaTabella(ADati)

Next

Call CreaTabella

Else
MsgBox "Selezionare la classe di sviluppo e la garanzia , " & _
"si ricorda che la garanzia non puo essere maggiore della classe di sviluppo " & _
"e che bisogna scegliere quale valore statistico considerare per " & _
"alimentare la lista delle prime 100 Combinazioni "



End If

End Sub
Sub AnalisiComb(aNum,Garanzia,aCombMig,nInizio,nFine,idValoreDaAna)

Dim k,j

Dim Rit
Dim RitMax
Dim Freq
Dim Valore




Call StatisticaFormazioneDL(aNum,Garanzia,Rit,RitMax,0,Freq,nInizio,nFine)
Select Case idValoreDaAna
Case 1
Valore = Freq
Case 2
Valore = Rit
Case 3
Valore = RitMax
End Select
For k = 1 To UBound(aCombMig)

If Valore >= aCombMig(k,0) Then

For j = UBound(aCombMig) To(k + 1) Step - 1
aCombMig(j,0) = aCombMig(j - 1,0)
aCombMig(j,1) = aCombMig(j - 1,1)
aCombMig(j,2) = aCombMig(j - 1,2)
aCombMig(j,3) = aCombMig(j - 1,3)
aCombMig(j,4) = aCombMig(j - 1,4)


Next
aCombMig(k,0) = Valore
aCombMig(k,1) = Freq
aCombMig(k,2) = Rit
aCombMig(k,3) = RitMax
aCombMig(k,4) = StringaNumeri(aNum)


Exit For

End If
Next
End Sub
Function InitSviluppaComb(Classe)

Dim k
ReDim aNum(90)

For k = 1 To 90
aNum(k) = k
Next

InitSviluppaComb = InitSviluppoIntegrale(aNum,Classe)

End Function

Function ScegliClasse()
ReDim aVoci(3)

aVoci(0) = "Estratto"
aVoci(1) = "Ambo"
aVoci(2) = "Terno"
aVoci(3) = "Quaterna"


ScegliClasse = ScegliOpzioneMenu(aVoci,2,"Secegli tipo combinazione") + 1
End Function

Function ScegliGaranzia()

ReDim aVoci(3)

aVoci(0) = "Estratto"
aVoci(1) = "Ambo"
aVoci(2) = "Terno"
aVoci(3) = "Quaterna"


ScegliGaranzia = ScegliOpzioneMenu(aVoci,2,"Secegli garanzia") + 1
End Function

Function ScegliValoreDaAnalizzare(sValore)

ReDim aVoci(2)
Dim i

aVoci(0) = "Frequenza"
aVoci(1) = "Ritardo"
aVoci(2) = "Ritardo massimo"



i = ScegliOpzioneMenu(aVoci,0,"Quale valore considerare per l'ordinamento ? ")
sValore = aVoci(i)
ScegliValoreDaAnalizzare = i + 1
End Function

 

[Membro cancellato 16574]

Buonanotte,
Postiamo il listato modificato ed aggiornato.

Option Explicit
'Listato 10elotto di solare
'http://forum.lottoced.com/forum/lottoced/area-download/2055032-listato-10elotto
Dim clsHSS
Sub Main
Dim nGaranzia,aCombMigliori
Dim idValoreDaAna,sValoreUsato
Dim k
Dim nClasse
Dim nInizio,nFine
Dim nStart,nend
Dim CombTot
ReDim aCombMigliori(90,10)
Dim Tipoarchivio,sFileBd
Tipoarchivio = ScegliArchivioDL
If Tipoarchivio > 00 Then
If Tipoarchivio = 02 Then
If MsgBox("Vuoi aggiornare le estrazioni prima di eseguire il listato",_
vbQuestion + vbYesNo," AGGIORNAMENTO ARCHIVIO ") = vbYes Then
Call AggiornaArchivioDL
End If
End If
'----------------------------------------------------------------------------------
' imposto il percorso per il file della base dati da usare
If Tipoarchivio = 01 Then sFileBd = GetDirectoryAppData & "BaseDati10Elotto.Dat"
If Tipoarchivio = 02 Then sFileBd = GetDirectoryAppData & "BaseDati10Elotto5M.Dat"
Call ImpostaArchivio10ELotto(Tipoarchivio)
' istanzio l'oggetto HSS
Set clsHSS = CreateObject("HSS.ClsHighSpeedStat")
' inizializzo l'archivio.N.B. E' la prima cosa da fare
Call clsHSS.Init(sFileBd,02)
' parametro 2 indica file 10 e lotto Serale e 5M del programma Spaziometria
'----------------------------------------------------------------------------------
nGaranzia = ScegliSorte
nClasse = ScegliClasse
idValoreDaAna = ScegliValoreDaAnalizzare(sValoreUsato)
nInizio = EstrazioneIniDL
nFine = EstrazioneFinDL
nStart = Timer
If nClasse > 00 And nGaranzia > 00 And nGaranzia <= nClasse And idValoreDaAna > 00 Then
Call Messaggio("Sviluppo combinazioni di classe " & nClasse)
CombTot = InitSviluppaComb(nClasse)
Call Messaggio(" Statistica combinazioni in corso ")
ReDim aCol(nClasse)
Do While GetCombSviluppo(aCol) = True
Call AnalisiComb(aCol,nGaranzia,aCombMigliori,nInizio,nFine,idValoreDaAna)
k = k + 01
If k Mod 10 = 00 Then
Call Messaggio("Statistica combinazioni in corso " & k & " di " & CombTot)
Call AvanzamentoElab(01,CombTot,k)
If ScriptInterrotto Then Exit Do
End If
Loop
nend = Timer
Call Messaggio(" Creazione Tabella ")
Call GetTitoli()
If Tipoarchivio = 01 Then Call Scrivi("Archivio analizzato : 10eLotto Serale",01,01,,01,04,,01)
If Tipoarchivio = 02 Then Call Scrivi("Archivio analizzato : 10eLotto 5minuti",01,01,,01,04,,01)
Call Scrivi("Numero Combinazioni: " & CombTot & " sviluppate in classe( " & Format2(nClasse) & _
" ) analizzate per punti( " & NomeSorte(nGaranzia) & " )",01,01,,01,04,,01)
Call Scrivi("La seguente lista mostra le prime 100 combinazioni in base al valore di " & _
sValoreUsato,01,01,,01,04,,01)
Call Scrivi("Range analizzato " & GetInfoEstrazioneDL(nInizio) & " fino a " & _
GetInfoEstrazioneDL(nFine),01,01,,01,04,,01)
Call Scrivi("Estrazioni analizzate totali : " &(EstrazioniRicercaDL),01,01,,01,04,,01)
Call Scrivi("Tempo di elaborazione : " & FormattaSecondi((nend + 01) - nStart),01,01,,01,04,,01)
Call Scrivi()
For k = 01 To UBound(aCombMigliori)
ReDim ADati(05)
ADati(01) = aCombMigliori(k,05)
ADati(02) = aCombMigliori(k,01)
ADati(03) = aCombMigliori(k,02)
ADati(04) = aCombMigliori(k,03)
ADati(05) = aCombMigliori(k,04)
Call AddRigaTabella(ADati)
Next
Call ScegliTabella()
Else
Call MsgBox("Selezionare la classe di sviluppo e la garanzia , " & _
"si ricorda che la garanzia non puo essere maggiore della classe di sviluppo " & _
"e che bisogna scegliere quale valore statistico considerare per " & _
"alimentare la lista delle prime 100 Combinazioni ")
End If
End If
End Sub
Function ScegliArchivioDL()
ReDim aVoci(02)
aVoci(01) = " 10eLotto Serale "
aVoci(02) = " 10eLotto 5minuti "
ScegliArchivioDL = ScegliOpzioneMenu(aVoci,01," Scegli Archivio ")
End Function
Sub AnalisiComb(aNum,Garanzia,aCombMig,nInizio,nFine,idValoreDaAna)
Dim k,j
Dim Rit
Dim RitMax
Dim RetRitIncrMax
Dim Freq
Dim Valore
Call clsHSS.StatisticaFormazioneDL(aNum,Garanzia,Rit,RitMax,RetRitIncrMax,Freq,nInizio,nFine)
Select Case idValoreDaAna
Case 01
Valore = Freq
Case 02
Valore = Rit
Case 03
Valore = RitMax
Case 04
Valore = RetRitIncrMax
End Select
For k = 01 To UBound(aCombMig)
If Valore >= aCombMig(k,00) Then
For j = UBound(aCombMig) To(k + 01) Step - 01
aCombMig(j,00) = aCombMig(j - 01,00)
aCombMig(j,01) = aCombMig(j - 01,01)
aCombMig(j,02) = aCombMig(j - 01,02)
aCombMig(j,03) = aCombMig(j - 01,03)
aCombMig(j,04) = aCombMig(j - 01,04)
aCombMig(j,05) = aCombMig(j - 01,05)
Next
aCombMig(k,00) = Valore
aCombMig(k,01) = Freq
aCombMig(k,02) = Rit
aCombMig(k,03) = RitMax
aCombMig(k,04) = RetRitIncrMax
aCombMig(k,05) = StringaNumeri(aNum,,True)
Exit For
End If
Next
End Sub
Function InitSviluppaComb(Classe)
Dim k
ReDim aNum(90)
For k = 01 To 90
aNum(k) = k
Next
InitSviluppaComb = InitSviluppoIntegrale(aNum,Classe)
End Function
Function ScegliSorte()
Dim aVoci(10),i
For i = 01 To 10
aVoci(i) = NomeSorte(i)
Next
ScegliSorte = ScegliOpzioneMenu(aVoci,02," Seleziona Sorte da Analizzare ")
End Function
Function ScegliClasse()
Dim aVoci(10),i
For i = 01 To 10
aVoci(i) = NomeSorte(i)
Next
ScegliClasse = ScegliOpzioneMenu(aVoci,02," Seleziona Classe di Sviluppo ")
End Function
Function ScegliValoreDaAnalizzare(sValore)
ReDim aVoci(04)
Dim i
aVoci(01) = " Frequenza "
aVoci(02) = " Ritardo "
aVoci(03) = " Ritardo Max. "
aVoci(04) = " Incr.Rit.Max "
i = ScegliOpzioneMenu(aVoci,01," Quale valore considerare per l'ordinamento ? ")
sValore = aVoci(i)
ScegliValoreDaAnalizzare = i + 01
End Function
Sub GetTitoli
Dim aTitoli
aTitoli = Array(aTitoli," Combinazione "," Frequenza "," Ritardo "," Ritardo Max. "," Incr.Rit.Max ")
Call InitTabella(aTitoli,01,,,05)
End Sub
Function ScegliTabella()
ReDim Voci(01)
Voci(00) = " Tabella Normale "
Voci(01) = " Tabella Ordinabile "
ScegliTabella = ScegliOpzioneMenu(Voci,01," Seleziona Tipo Tabella ")
If ScegliTabella = 00 Then Call CreaTabella()
If ScegliTabella = 01 Then Call CreaTabellaOrdinabile
End Function
Function FormattaSecondi(s)'by Mike8
'Questa Function trasforma il numero di secondi passato come parametro in stringa
' passando i secondi si ottengono ore minuti e secondi in formato hh:mm:ss
' s ---> Numero di secondi da formattare
' ritorna una stringa il cui formato è hh:mm:ss
'(la function non funziona se in totale abbiamo piu di 99 ore )
Dim hh
Dim Mm
Dim Ss
Dim TimeStr
hh = s \ 3600
Mm =(s Mod 3600) \ 60
Ss = s -((hh * 3600) +(Mm * 60))
TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
FormattaSecondi = TimeStr
End Function

Controllare Sempre .
Salvo Errori ed Omissis .

 

[solare]

Grazie infinite della tua bravura è disponibilità.