Cerco un listato che

[solare]

Ciao, mi servirebbe un listato che mi trovi il ritardo attuale e storico per estratto relativo alle decine naturali, decine cabalistiche e cadenze
grazie infinite.

 

[joe]

Ciao solare,

Scrivo di ciò che normalmente non uso ... dunque non so ...

penso che in "Statistiche ... su Formazioni" di Spaziometria

dovrebbero esserci i gruppi classici a cui ti riferisci.

Dovrebbe pertanto essere possibile calcolare quanto richiedi.

Anche inserire eventualmente le tabelle mancanti.

Script probabilmente l'ho già fatto per Eugenio ...

e ne ricordo in un basic NON compatibile con Spaziometria/L8

uno ma non saprei come ritrovarlo.

 

[solare]

Ciao JOE, io ho trovato questo.
Però non tiene conto dell'impostazione delle estrazioni di spaziometria.

Option Explicit
Dim clsHSS
Sub Main()
Dim nSorte
Dim Ini,fin
Dim r,nx
Dim Inistart,FinEnd
Dim aTitoli,aNumeri
Dim RetRit,RetRitMax,IncrRitMax,RetFre
Dim aRuota(01),a(09)
Dim RetEsito,RetEstratti,RetIdEstr
Dim RetEstratti00,RetEstratti01,RetEstratti02
Dim sFileBd
sFileBd = GetDirectoryAppData & "BaseDati.dat"
Set clsHSS = CreateObject("HSS.ClsHighSpeedStat")
Call clsHSS.Init(sFileBd,01)
nSorte = GetScegliSorte
Ini = EstrazioneIni
fin = EstrazioniArchivio
Call Scrivi(" Statistica dal " & DataEstrazione(Ini) & " al " & DataEstrazione(fin) & " ",01,00,06)
Call Scrivi(" Totale estrazioni " &(EstrazioniRicerca),01,- 01,04)
Call Scrivi()
Call Scrivi(" STATISTICA SULLE DECINE ",1,1,,0,4)
Call Scrivi(" Verifica statistica per sorte di... " & NomeSorte(nSorte),01,01,,02,04)
Call Scrivi()
Call Scrivi()
Inistart = Timer
For r = 01 To 12
aRuota(01) = r
aTitoli = Array(aTitoli," ID "," RUOTA "," FORMAZIONE "," RITARDO "," RITARDO MAX. "," INC.RIT.MAX "," FREQUENZA "," USCITA - 00 "," USCITA - 01 "," USCITA - 02 "," I.C "," ULTIMI 10 RITARDI")
Call InitTabella(aTitoli,vbGreen,,3,0)
a(01) = "01.02.03.04.05.06.07.08.09.10"
a(02) = "11.12.13.14.15.16.17.18.19.20"
a(03) = "21.22.23.24.25.26.27.28.29.30"
a(04) = "31.32.33.34.35.36.37.38.39.40"
a(05) = "41.42.43.44.45.46.47.48.49.50"
a(06) = "51.52.53.54.55.56.57.58.59.60"
a(07) = "61.62.63.64.65.66.67.68.69.70"
a(08) = "71.72.73.74.75.76.77.78.79.80"
a(09) = "81.82.83.84.85.86.87.88.89.90"
For nx = 01 To 09
Messaggio NomeRuota(r)
AvanzamentoElab 01,11,r
aNumeri = Split("00." & a(nx),".")
Call clsHSS.StatisticaFormazione(aNumeri,aRuota,nSorte,RetRit,RetRitMax,IncrRitMax,RetFre,Ini,fin)
Call clsHSS.VerificaEsito(aNumeri,aRuota,fin - RetRit,nSorte,,,RetEsito,,RetEstratti,RetIdEstr)
Call clsHSS.StatisticaFormazione(aNumeri,aRuota,nSorte,RetRit,RetRitMax,IncrRitMax,RetFre,Ini,fin)
Call clsHSS.VerificaEsito(aNumeri,aRuota,fin - RetRit,nSorte,,,RetEsito,,RetEstratti,RetIdEstr)
Call clsHSS.VerificaEsito(aNumeri,aRuota,fin - 00,01,01,,,,RetEstratti00)
Call clsHSS.VerificaEsito(aNumeri,aRuota,fin - 01,01,01,,,,RetEstratti01)
Call clsHSS.VerificaEsito(aNumeri,aRuota,fin - 02,01,01,,,,RetEstratti02)
Dim qRit,conta01,rt01,n1
Dim aRetRitardi,aRetIdEstr,aRitardi
qRit = 10 ' elenco ultimi N_Ritardi
Call ElencoRitardiTurbo(aNumeri,aRuota,nSorte,Ini,fin,aRetRitardi,aRetIdEstr)
rt01 = ""
conta01 = 0
For n1 = UBound(aRetRitardi) - 01 To LBound(aRetRitardi) Step - 01
conta01 = conta01 + 01
If conta01 <= qRit Then
rt01 = FormattaStringa(aRetRitardi(n1),"000") & "." & rt01
Else
Exit For
End If
Next
rt01 = RimuoviLastChr(rt01,".")
aRitardi = rt01
ReDim avalori(12)
avalori(01) = Format2(nx)
avalori(02) = NomeRuota(aRuota(01))
avalori(03) = StringaNumeri(aNumeri,,True)
avalori(04) = RetRit
avalori(05) = RetRitMax
avalori(06) = IncrRitMax
avalori(07) = RetFre
avalori(08) = RetEstratti00
avalori(09) = RetEstratti01
avalori(10) = RetEstratti02
avalori(11) = Round(((avalori(07) / EstrazioniRicerca) * avalori(04)),2)
avalori(12) = aRitardi
Call AddRigaTabella(avalori,,,4,,1)
Call SetColoreCella(04,RGB(164,255,255))
Call SetColoreCella(03,,vbBlue)
Call SetColoreCella(05,RGB(255,184,149))
Call SetColoreCella(07,RGB(255,255,128),0)
If IncrRitMax > 00 Then Call SetColoreCella(06,RGB(255,128,255))
If RetRit = 00 Then Call SetColoreCella(04,RGB(255,128,255)):Call SetColoreCella(08,RGB(255,128,255))
If RetRit = 01 Then Call SetColoreCella(04,RGB(095,144,246)):Call SetColoreCella(09,RGB(095,144,246))
If RetRit = 02 Then Call SetColoreCella(04,RGB(200,176,251)):Call SetColoreCella(10,RGB(200,176,251))
Next
Call CreaTabella()
Call Scrivi()
Next
Set clsHSS = Nothing
FinEnd = Timer
Call Scrivi("Tempo di elaborazione : " & GetFormattaSecondi((FinEnd + 01) - Inistart))
Call Scrivi()
Call Scrivi(" Tabella listed By Amaretto ",1,- 1,6)
End Sub
Function GetScegliSorte()
ReDim aVoci(04)
aVoci(00) = "Estratto"
aVoci(01) = "Ambo"
aVoci(02) = "Terno"
aVoci(03) = "Quaterna"
aVoci(04) = "Cinquina"
GetScegliSorte = ScegliOpzioneMenu(aVoci,01,"Secegli Tipo Sorte") + 01
End Function
Function GetFormattaSecondi(s)
'Questa Function trasforma il numero di secondi passato come parametro in una 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)
GetFormattaSecondi = TimeStr
End Function

 

[joe]

Ciao solare,

Il listato che hai allegato,

penso sia una versione del sorgente ... migliorato in velocità (nella parte scritta da Luigi)

e poi modificato nelle tabelle. (nella parte scritta da Amaretto).

Replica le funzioni cardine di Spaziometria

cioè quelle che ti ho proposto di usare direttamente nel programma.

I limiti dell' intervallo sono facilmente modificabili. (Molto facilmente)

Per quanto riguarda le formazioni invece vale quanto ti avevo scritto.

Bisognerebbe creare 3 tabelle differenti una per ogni decina

Una di queste (3 decine) naturalmente, è già nello script.

Oppure si crea uno script ad-hoc che sarà sicuramente più lento se deve considerare gli storici.

Ma che potrebbe raggruppare le 3 ricerche.

Il problema è che età / caldo / altri impegni ...

e troppe questioni purtroppo non sterili quanto sicuramente inutili ed ancor più dannose,

mi inducono a non assumere un impegno che potrebbe richiedere (a me) parecchio tempo.

 

[solare]

Grazie comunque JOE
capisco

 

[joe]

Ma deve essere proprio ... uno script ...

o, come hai scritto ti interessano le statistiche attuali ?

 

[solare]

vedo di fare con spaziometria
come mi hai indicato tu
Ciao

 

[joe]

Prova con il classico un motore di ricerca

Lottologia Decine Cabalistiche

 

[solare]

OK

 

[solare]

Il problema del listato che ho inserito era che analizzava l'ultima estrazione indipendentemente da quale impostavo.
ho provato a mettere fin = EstrazioniArchivio-1 così facendo posso decidere fino a quale estrazione elaborare.
l'unica cosa che devo di volta in volta modificare quel -1

 

[joe]

Ciao solare,

Si deve solo sostituire quella istruzione con EstrazioneFin

Di volta in volta, si sposta il limite finale dell'archivio con le frecce.

Ti ho aggiunto una linea per controllare la data di elaborazione

per a cui ha calcolato la statistica.

Lo script che ho inserito, funzionante, risulta invece rovinato ed inutilizzabile....

... dunque l'ho tolto.

 

[solare]

Grazie joe
mi da errore a questa riga :
sFileBd = GetDirectoryAppData & "BaseDati.dat"

 

[joe]

Prendi per buono lo script originale cambi solo quanto ti ho scritto.

 

[solare]

OK