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
    giovedì 09 ottobre 2025
    Bari
    09
    10
    42
    73
    59
    Cagliari
    14
    65
    66
    79
    83
    Firenze
    71
    15
    32
    04
    61
    Genova
    08
    02
    18
    87
    84
    Milano
    33
    08
    84
    80
    41
    Napoli
    29
    81
    50
    17
    83
    Palermo
    14
    28
    74
    19
    60
    Roma
    76
    32
    55
    67
    90
    Torino
    07
    02
    66
    15
    70
    Venezia
    34
    73
    70
    40
    09
    Nazionale
    87
    79
    36
    46
    02
    Estrazione Simbolotto
    25
    07
    23
    17
    30
Indietro
Alto