Novità

Cortesia agli esperti di listati

solare

Advanced Member >PLATINUM<
Chiedo se possibile aggiungere la possibilità di poter selezionare l'elaborazione su due ruote anziché uno.......Grazie
Option Explicit
Sub Main
' Si prega sempre di verificare e confrontare i risultatiottenuti dallo script con altre fonti
' per verificarne la correttezza
' se si dovessero verificare bugs segnalarli per le opportune correzioni.
'
Dim Ini,Fin,nEstr,es,k,x,r,nValore,idOrd,TipOrd,Ctr,z
Dim r1,n1,qRit,conta1
Dim scartoRit,Gen,Feb,Mar,Apr,Mag,Giu,Lug,Ago,Sett,Ott,Nov,Dic
Dim IdMax,aRetDiff,Conta,aIncr,Sincrementi,qIncr,y
Dim DevStd,disCeb,ScaCeb,aRitardi
Dim nColTotSvil
Dim s,e,ritardo,ritardomax,IncrRitMax,RitMed,RitMese
Dim Frequenza,freqTeorica,FreqMese,freq,FreqTot,Scarto
Dim nNumeri,aColonne
ReDim aNumeri(0)
Dim aRu(1)
Dim nCombinazione,nSorte,nCiclo
Dim aTitolo
ReDim aRetRitardi(0)
ReDim aRetIdEstr(0)
Fin = EstrazioneFin
qRit = 10 ' elenco ultimi N_Ritardi
qIncr = 5 ' elenco ultimi N_incrementi
If ImpostaParametri(nNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,aRu,r,Ini) = False Then
MsgBox "Parametri non corretti",vbCritical
Exit Sub
End If
'Imposto i titoli delle colonne della tabella statistica
aTitolo = Array("","ID","Comb","freq","Scarto","Rit","aRitardi","RitMed","RitSto","IncR.s","aIncrementi","ScartoRit","DevStd","disCeb","ScaCeb99%","Gen ","Feb","Mar","Apr","Mag","Giu","Lug","Ago","Set","Ott","Nov","Dic")
InitTabella aTitolo,RGB(108,194,243),,3,vbWhite', "Consolas"
nEstr = ContaEstrazioni(Ini,Fin,r)
nValore = Round(CicloTeorico(nCombinazione,nSorte,CInt(Ctr)),2)' ctr= 1 (=1R);=10(=TT)
freqTeorica = Round(Dividi(nEstr,nValore),2)
ReDim aColSviluppo(0)
nColTotSvil = Combinazioni(UBound(nNumeri),nCombinazione)
ReDim nMese(nColTotSvil,12)
For z = 1 To 12
Call ImpostaEstrazioniAttivePerMese(z,Ini,Fin)
nColTotSvil = InitSviluppoIntegrale(nNumeri,nCombinazione)
k = 0
Do While GetCombSviluppo(aColSviluppo)
k = k + 1
nMese(k,z) = TrovaFrequenzaMese(aColSviluppo,aRu,nSorte,Ini,Fin,z)
Loop
Next
Call ResetEstrazioniAttive(z,Ini,Fin)
k = 0
nColTotSvil = InitSviluppoIntegrale(nNumeri,nCombinazione)
Do While GetCombSviluppo(aNumeri)
k = k + 1
Messaggio "Elaborazione in corso id sviluppo: " & k
AvanzamentoElab 1,nColTotSvil,k
If ScriptInterrotto Then Exit Do
s = StringaNumeri(aNumeri,,True)
Call StatisticaFormazioneTurbo(aNumeri,aRu,nSorte,ritardo,ritardomax,IncrRitMax,Frequenza,Ini,Fin)
FreqTot = Frequenza
RitMese = TrovaRitardoMese(aNumeri,aRu,nSorte,Ini,Fin,"TUTTI")
Scarto = Round(FreqTot - freqTeorica,2)
scartoRit = Round(ritardomax - ritardo,2)
Call ElencoRitardiTurbo(aNumeri,aRu,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr)
r1 = ""
conta1 = 0
For n1 = UBound(aRetRitardi) - 1 To LBound(aRetRitardi) Step - 1
conta1 = conta1 + 1
If conta1 <= qRit Then
r1 = FormattaStringa(aRetRitardi(n1),"000") & "." & r1
Else
Exit For
End If
Next
r1 = RimuoviLastChr(r1,".")
aRitardi = r1
RitMed = RitardoMedio(aRetRitardi)
DevStd = CalcolaDeviazioneStd(aRetRitardi)
disCeb = Round(RitMed +(10*DevStd),2)
ScaCeb = Round(disCeb - RitMese,2)
Call GetArrayDiffRitMax(aRetRitardi,aRetDiff)
IdMax = UBound(aRetRitardi) - 1
Sincrementi = ""
Conta = 0
For y = 1 To UBound(aRetDiff)
Conta = Conta + 1
If Conta <= qIncr Then
Sincrementi = FormattaStringa(aRetDiff(y),"000") & "." & Sincrementi
IdMax = IdMax - 1
Else
Exit For
End If
Next
Sincrementi = RimuoviLastChr(Sincrementi,".")
aIncr = Sincrementi
s = RimuoviLastChr(s,".")
ReDim aRisultato(26)
Call AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,aRitardi,RitMed,ritardomax,IncrRitMax,aIncr,scartoRit,DevStd,disCeb,ScaCeb,nMese(k,1),nMese(k,2),nMese(k,3),nMese(k,4),nMese(k,5),nMese(k,6),nMese(k,7),nMese(k,8),nMese(k,9),nMese(k,10),nMese(k,11),nMese(k,12))
Call AddRigaTabella(aRisultato,,,3,RGB(0,0,0))',"Consolas")
Call SetColoreCella(2,RGB(215,215,255),2)
Loop
Scrivi FormatSpace("script By I Legend per lottoCed's amici",10,- 1)
Scrivi
Scrivi "Tabella Statistica per formazioni libere" & " ",1,,RGB(252,227,143),,5
Scrivi
Scrivi "Range Ricerca Estrazioni dal :{" & DataEstrazione(Ini) & " } al : {" & DataEstrazione(Fin) & "}",1,,,,3
Scrivi "Estrazioni Totali Analizzati :{" & nEstr & "}",1,,,,3
Scrivi "Numeri di ricerca :{" & StringaNumeri(nNumeri) & "}",1,,,,3
Scrivi "Sviluppo numeri in :{" & k & " " & NomeCombinazione(nCombinazione) & "}",1,,,,3
Scrivi "Analesi combinazione per :{" & NomeSorte(nSorte) & "}",1,,,,3
Scrivi "Ciclo Teorico :{" & nValore & "}",1,,,,3
Scrivi "Frequenza Teorica :{" & freqTeorica & "}",1,,,,3
Scrivi "Ruota di ricerca :{" & NomeRuota(aRu(1)) & "}",1,,,,3
Scrivi

Call CreaTabellaOrdinabile()
End Sub
' riporto qui di seguito tutte le funzioni utilizzate
' per la sub main
' ovviamente possono essere ottimizzate
Sub AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,aRitardi,RitMed,ritardomax,IncrRitMax,aIncr,scartoRit,DevStd,disCeb,ScaCeb,Gen,Feb,Mar,Apr,Mag,Giu,Lug,Ago,Sett,Ott,Nov,Dic)
aRisultato(1) = k ' id
aRisultato(2) = s ' combinazioni analizzate
aRisultato(3) = FreqTot'frequenza combinazione
aRisultato(4) = Scarto ' differenza freq.reeale e differenza teorica
aRisultato(5) = RitMese ' ritardo cronologico
aRisultato(6) = aRitardi
aRisultato(7) = RitMed ' ritardo medio
aRisultato(8) = ritardomax ' ritardo storico
aRisultato(9) = IncrRitMax ' incremento ritardo storico
aRisultato(10) = aIncr
aRisultato(11) = scartoRit
aRisultato(12) = DevStd ' deviazione standard
aRisultato(13) = disCeb 'disegualianza di cebicev
aRisultato(14) = ScaCeb ' scarto tra valore ipotizzato e valore del ritardo reale
aRisultato(15) = Gen
aRisultato(16) = Feb
aRisultato(17) = Mar
aRisultato(18) = Apr
aRisultato(19) = Mag
aRisultato(20) = Giu
aRisultato(21) = Lug
aRisultato(22) = Ago
aRisultato(23) = Sett
aRisultato(24) = Ott
aRisultato(25) = Nov
aRisultato(26) = Dic
End Sub
Function ImpostaParametri(aNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,aRu,Ruota,Ini)
Dim bRet
Ini = InizioArchivio(8163)
If Ini > 0 Then
Call ScegliNumeri(aNumeri)
If IsArray(aNumeri) Then
nCombinazione = ScegliCombinazione
If nCombinazione > 0 Then
nSorte = SelEsito
If nSorte > 0 Then
Do While nCombinazione < nSorte
MsgBox "hai inserito Un Valore errato riscrivi ": nSorte = CInt(SelEsito)
If nSorte = - 1 Then Exit Do
Loop
If nSorte > 0 Then
Ruota = SelRuota ' funziona per selezionare la ruota statistica su tutte o solo per una ruota
If Ruota > 0 Then
aRu(1) = Ruota
If Ruota = 11 Then
Ctr = 10
Else
Ctr = 1 ' valore utilizzato per calcolo del ciclo teorico
End If
bRet = True ' per default torna true
End If
End If
End If
End If
End If
End If
ImpostaParametri = bRet
End Function
Function TrovaFrequenzaMese(aNumeri,aRu,nSorte,Ini,fin,nMese)
Dim k
Dim FreqMese
FreqMese = SerieFreqTurbo(Ini,fin,aNumeri,aRu,nSorte)
TrovaFrequenzaMese = FreqMese
End Function
Sub ImpostaEstrazioniAttivePerMese(nMese,Ini,fin)
Dim k
If nMese = "TUTTI" Then
Call ResetEstrazioniAttive(nMese,Ini,fin)
Else
For k = Ini To fin
If Mese(k) = nMese Then
Call ImpostaEstrazione(k,True)
Else
Call ImpostaEstrazione(k,False)
End If
Next
End If
End Sub
Sub ResetEstrazioniAttive(nMese,Ini,fin)
Dim k
For k = Ini To fin
Call ImpostaEstrazione(k,True)
Next
End Sub
Function TrovaRitardoMese(aNumeri,aRu,nSorte,Ini,fin,nMese)
Dim k
Dim RitMese
If nMese <> "TUTTI" Then
Call ImpostaEstrazioniAttivePerMese(nMese,Ini,fin)
End If
RitMese = SerieRitardoTurbo(Ini,fin,aNumeri,aRu,nSorte)
TrovaRitardoMese = RitMese
End Function
Function NomeCombinazione(a)
Dim aVoci
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine")
NomeCombinazione = aVoci(a)
End Function
Function ScegliCombinazione
Dim ret
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine")
ret = ScegliOpzioneMenu(aVoci,1," Combina i numeri In :")
' serve per gestire il tasto annulla
ScegliCombinazione = ret
End Function
Function SelEsito
Dim ret
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
ret = ScegliOpzioneMenu(aVoci,1," Analesi per Sorte di : ")
SelEsito = ret
End Function
Function SelRuota
Dim ret
Dim aVoci
' gli Array partono sempre da 0
aVoci = Array("","BARI","CAGLIARI","FIRENZE","GENOVA","MILANO","NAPOLI","PALERMO","ROMA","TORINO","VENEZIA","TUTTE","NAZIONALE")
ret = ScegliOpzioneMenu(aVoci,1," Analizza Ruota di : ")
SelRuota = ret
End Function
Function InizioArchivio(nInizio)
Dim es
Dim ret
ReDim aVoci(EstrazioneFin)
For es = nInizio To EstrazioneFin
aVoci(es) = DataEstrazione(es)
Next
ret = ScegliOpzioneMenu(aVoci,nInizio,"Inserisci Data Inizio Analisi")
InizioArchivio = ret
End Function
Function RitardoMedio(aRitardi())
Dim k
Dim nElementi
Dim nMedia
For k = 1 To UBound(aRitardi) - 1
nElementi = nElementi + 1
nMedia = nMedia + aRitardi(k)
Next
nMedia = Round(Dividi(nMedia,nElementi),2)
RitardoMedio = nMedia
End Function
Function CalcolaDeviazioneStd(aRitardi())
Dim k
Dim somRit,nMedia,nElementi,nVarianza,nSomSQVar
For k = 1 To UBound(aRitardi) - 1
nElementi = nElementi + 1
somRit = somRit + aRitardi(k)
Next
nMedia = Round(Dividi(somRit,nElementi))
For k = 1 To UBound(aRitardi) - 1
nSomSQVar = nSomSQVar +((nMedia - aRitardi(k)) ^ 2)
nVarianza = Round(Dividi(nSomSQVar,nElementi),2)
Next
CalcolaDeviazioneStd = Round(Sqr(nVarianza),2)
End Function
Function ContaEstrazioni(Ini,Fin,r)
Dim Conta,es
For es = Ini To Fin
If SommaEstratti(es,r) >= 15 Then Conta = Conta + 1
Next
ContaEstrazioni = Conta
End Function
Function GetArrayDiffRitMax(aRitardi,aRetDiff)
Dim idMax,idTmp
Dim nQDiff
Call OrdinaMatrice(aRitardi,1)
nQDiff = 0
ReDim aRetDiff(nQDiff)
idMax = UBound(aRitardi)' -1
Do While idMax > 0
idTmp = idMax - 1
If idTmp > 0 Then
nQDiff = nQDiff + 1
ReDim Preserve aRetDiff(nQDiff)
aRetDiff(nQDiff) = aRitardi(idMax) - aRitardi(idTmp)
Else
Exit Do
End If
idMax = idMax - 1
Loop
End Function
 
Ciao solare ti segnalo che in questo script che è la prima versione ci sono dei bugs ( errori)
. Era stata postata la versione modificata e corretta.

Ciao:)
 
Ok ti ringrazio.
Se qualche amico del forum mi può dare qualche indicazione dove poter trovare ul listato simile.
a servirebbe un listato che analizzi dei numeri che io inserisco e che mi dia una statistica mensile magari con la possibilità di poter analizzare una o due ruote.
 
Ciao ancora nulla




Logo%20Cercasi%20volontari_1_.jpg
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 18 febbraio 2025
    Bari
    72
    83
    64
    59
    43
    Cagliari
    60
    55
    49
    07
    14
    Firenze
    11
    68
    62
    04
    21
    Genova
    86
    23
    44
    85
    71
    Milano
    11
    82
    42
    09
    14
    Napoli
    89
    86
    65
    49
    14
    Palermo
    79
    34
    80
    78
    20
    Roma
    26
    21
    13
    64
    57
    Torino
    64
    11
    17
    02
    58
    Venezia
    64
    82
    30
    04
    19
    Nazionale
    26
    37
    68
    54
    87
    Estrazione Simbolotto
    Cagliari
    39
    30
    04
    11
    14
Indietro
Alto