Novità

x mike58

solare

Advanced Member >PLATINUM<
Ciao, chiedo se possibile aggiunge la possibilità di selezionare più ruote per la statistica


Option Explicit
Sub Main
Dim Ini,Fin,nEstr,es,k,x,r,nValore,idOrd,TipOrd,Ctr,z
Dim DevStd,disCeb,ScaCeb
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
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","RitMed ","RitSto","IncR.s","DevStd","disCeb","ScaCeb99%", "GEN","FEB","MAR","APR","MAG","GIU","LUG","AGO","S et","OTT","NOV","DIC")
InitTabella aTitolo,RGB(108,194,243),,3,vbWhite', "Consolas"
'conto le estrazioni utili
nEstr = ContaEstrazioni(Ini,Fin,r)
nValore = Round(CicloTeorico(nCombinazione,nSorte,CInt(Ctr)) ,2)' ctr= 1 (=1R);=10(=TT)
freqTeorica = Round(Dividi(nEstr,nValore),2)
'aColonne = SviluppoIntegrale(nNumeri,nCombinazione) ' sviluppo i l'array dei numeri scelti ,nella combinazione scelta
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
'For k = 1 To UBound(aColonne) ' ciclo per leggere la colonna k della matrice aColonne
's = "" ' dichiaro la stringa combinazione vuota
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,ritar do,ritardomax,IncrRitMax,Frequenza,Ini,Fin)
FreqTot = Frequenza
' funzione per calcolare il ritardo globale della formazione
' questo è un espediente che ho dovuto analizzare visto la frequenza mese
RitMese = TrovaRitardoMese(aNumeri,aRu,nSorte,Ini,Fin,"TUTTI ")
Scarto = Round(FreqTot - freqTeorica,2)
' richiamo la funzione elenca ritardi, per poter attingere alla marice che elenca i ritardi voce:( aRetRitardi)
Call ElencoRitardiTurbo(aNumeri,aRu,nSorte,Ini,Fin,aRet Ritardi,aRetIdEstr)
' scritta funzione per calcolare il ritardo medio della formazione
RitMed = RitardoMedio(aRetRitardi)
' scritta funzione per calcolo deviazione standard della funzione
'
DevStd = CalcolaDeviazioneStd(aRetRitardi)
disCeb = Round(RitMed +(10*DevStd),2)
ScaCeb = Round(disCeb - RitMese,2)
s = RimuoviLastChr(s,".")
ReDim aRisultato(23)
Call AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scart o,RitMese,RitMed,ritardomax,IncrRitMax,DevStd,disC eb,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),nM ese(k,9),nMese(k,10),nMese(k,11),nMese(k,12))
Call AddRigaTabella(aRisultato,,,3,RGB(0,0,0))',"Consol as")
'se decidessi di ordinare il mese? legge il primo colore? No Legge l'ultima istruzione
Call SetColoreCella(CInt(idOrd),RGB(221,255,230),2)
Call SetColoreCella(Mese(EstrazioneFin) + 11,RGB(215,215,255),2)
Loop
Scrivi FormatSpace("script By I Legend per lottoCed's amici",150,- 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 - 1 & " " & 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 "Ordinamento colonna num :{" & aTitolo(idOrd) & "}",1,,,,3
Scrivi "Ordino Colonna in modo :{" & TipOrd & "}",1,,,,3
Scrivi
Call SetTableWidth("100%")
If TipOrd = 1 Then Call AddRigaTabella(aTitolo,RGB(108,194,243),,3,vbWhite )',"Consolas")
Call CreaTabella(idOrd,TipOrd,0)
'If ScriptInterrotto Then Exit Sub
End Sub
' riporto qui di seguito tutte le funzioni utilizzate
' per la sub main
' ovviamente possono essere ottimizzate
Sub AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scart o,RitMese,RitMed,ritardomax,IncrRitMax,DevStd,disC eb,ScaCeb,Gen,Feb,Mar,Apr,Mag,Giu,Lug,Ago,Stt,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) = RitMed ' ritardo medio
aRisultato(7) = ritardomax ' ritardo storico
aRisultato(8) = IncrRitMax ' incremento ritardo storico
aRisultato(9) = DevStd ' deviazione standard
aRisultato(10) = disCeb 'disegualianza di cebicev
aRisultato(11) = ScaCeb ' scarto tra valore ipotizzato e valore del ritardo reale
aRisultato(12) = Gen 'Gennaio ' frequenza per mese
aRisultato(13) = Feb'Gennaio ' frequenza per mese
aRisultato(14) = Mar 'Gennaio ' frequenza per mese
aRisultato(15) = Apr 'Gennaio ' frequenza per mese
aRisultato(16) = Mag 'Gennaio ' frequenza per mese
aRisultato(17) = Giu 'Gennaio ' frequenza per mese
aRisultato(18) = Lug 'Gennaio ' frequenza per mese
aRisultato(19) = Ago 'Gennaio ' frequenza per mese
aRisultato(20) = Stt 'Gennaio ' frequenza per mese
aRisultato(21) = Ott 'Gennaio ' frequenza per mese
aRisultato(22) = Nov 'Gennaio ' frequenza per mese
aRisultato(23) = Dic 'Gennaio ' frequenza per mese
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
'If nCombinazione < nSorte Then MsgBox "hai inserito Un Valore errato riscrivi ": nSorte = CInt(SelEsito)
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
idOrd = Ordinamento ' seleziono la colonna che voglio ordinare
If idOrd > 0 Then
TipOrd = TipoOrdinamento ' Crescente o decrescente
bRet = True ' per default torna true
End If
End If
End If
End If
End If
End If
End If
ImpostaParametri = bRet
End Function
Function TrovaFrequenzaMese(aNumeri,aRu,nSorte,Ini,fin,nMes e)
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 ris
Select Case a
Case 1
ris = "Estratti"
Case 2
ris = "Ambi"
Case 3
ris = "Terzine"
Case 4
ris = "Quartine"
Case 5
ris = "Cinquine"
End Select
NomeCombinazione = ris
End Function
Function Ordinamento
Dim Ord
Dim ret
Dim aTitolo
' gli array partono sempre da 0
aTitolo = Array("","","","freq","Scarto","Rit","RitMed","Rit Sto","IncR.s","DevStd","disCeb","ScaCeb99%","GEN", "FEB","MAR","APR","MAG","GIU","LUG","AGO","Set","O TT","NOV","DIC")




ret = ScegliOpzioneMenu(aTitolo,3,"Seleziona Ordinamento per la colonna :")
' serve per gestire il tasto annulla
If ret >= 0 Then
Ord = ret
Else
Ord = ret
End If
Ordinamento = Ord
End Function
Function TipoOrdinamento
Dim Ord
Dim ret
Dim aTitolo
aTitolo = Array("","Crescente","DeCrescente")
ret = ScegliOpzioneMenu(aTitolo,1,"Seleziona Tipo di Ordinamento :")
' serve per gestire il tasto annulla
If ret >= 0 Then
If ret = 1 Then Ord = 1 : Else Ord = - 1
Else
Ord = ret
End If
TipoOrdinamento = Ord
End Function
Function ScegliCombinazione
Dim ret
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","C inquine")
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","Cin quina")
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","MIL ANO","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
 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 13 dicembre 2025
    Bari
    61
    81
    73
    68
    78
    Cagliari
    76
    59
    33
    78
    23
    Firenze
    10
    37
    58
    30
    71
    Genova
    17
    45
    37
    36
    72
    Milano
    10
    71
    70
    46
    87
    Napoli
    21
    11
    51
    68
    01
    Palermo
    84
    72
    26
    17
    79
    Roma
    39
    63
    46
    67
    50
    Torino
    35
    86
    79
    68
    85
    Venezia
    67
    68
    22
    77
    76
    Nazionale
    46
    12
    72
    65
    70
    Estrazione Simbolotto
    Venezia
    05
    13
    40
    35
    10
Indietro
Alto