Novità

sript statistica di un numero nelle cinque posizioni

i legend

i legend

Premium Member
controllare se lo script restituisce risultati corretti
lo script è richiesto da paolo, spero sia quanto richiesto
Codice: 
Option Explicit
Sub Main
' Controllare Se lo script restituisce output corretti
'Se si dovessero riscontrare eventuali bugs  comunicarli
'Lo script è di natura statistica non restituisce previsioni
' script per Paolo su Lottoced
    Dim x,y,j,i,z,w 'variabili contatore
    Dim rit1,ritmax1,IncRitmax1,Freq1
    Dim rit2,ritmax2,IncRitmax2,Freq2
    Dim rit3,ritmax3,IncRitmax3,Freq3
    Dim rit4,ritmax4,IncRitmax4,Freq4
    Dim rit5,ritmax5,IncRitmax5,Freq5
    Dim ritT,ritmaxT,IncRitmaxT,FreqT,aPosT
    Dim RMax,FMax,RRMax,rIncMax
    Dim Ruota,Num
    Dim aTitoli(24),aPos1(5),aPos2(5),aPos3(5),aPos4(5),aPos5(5),aPosTot(5)
    ReDim aRuote(0),aNum(0)
    ScegliNumeri(aNum)
    ScegliRuote(aRuote)
    Call GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot)
    Call GetTitoli(aTitoli)
    Call InitTabella(aTitoli,RGB(192,192,192))
    
    For x = 1 To UBound(aRuote)
        Ruota = aRuote(x)
        Call Messaggio("Sto calcolando la ruota di : " & Ruota)
        Call AvanzamentoElab(1,12,Ruota)
        For y = 1 To UBound(aNum)
            Num = aNum(y)
            Call StatEstratto(Ruota,Num,rit1,ritmax1,IncRitmax1,Freq1,,,,,aPos1)
            Call StatEstratto(Ruota,Num,rit2,ritmax2,IncRitmax2,Freq2,,,,,aPos2)
            Call StatEstratto(Ruota,Num,rit3,ritmax3,IncRitmax3,Freq3,,,,,aPos3)
            Call StatEstratto(Ruota,Num,rit4,ritmax4,IncRitmax4,Freq4,,,,,aPos4)
            Call StatEstratto(Ruota,Num,rit5,ritmax5,IncRitmax5,Freq5,,,,,aPos5)
            Call StatEstratto(Ruota,Num,ritT,ritmaxT,IncRitmaxT,FreqT,,,,,aPosT)
            ReDim aRis(24)
            Call alimentaArrayTabella(aRis,SiglaRuota(Ruota),Num,Freq1,Freq2,Freq3,Freq4,Freq5,FreqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitmax1,IncRitmax2,IncRitmax3,IncRitmax4,IncRitmax5,ritT,FMax,RMax,RRMax,rIncMax)
            Call AddRigaTabella(aRis)
            Call GetFormatCella(aRis,FMax,RMax,RRMax,rIncMax)
        Next
    Next
    Call GetIntestazione(aNum,aRuote)
    Call CreaTabellaOrdinabile
End Sub
Sub GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot)
    Dim i
    For i = 1 To 5
        aPosTot(i) = True
    Next
    aPos1(1) = True
    aPos2(2) = True
    aPos3(3) = True
    aPos4(4) = True
    aPos5(5) = True
End Sub
Sub GetTitoli(aTitoli)
    aTitoli(1) = "Ruota"
    aTitoli(2) = "Num.Ric."
    aTitoli(3) = "F.P1"
    aTitoli(4) = "F.P2"
    aTitoli(5) = "F.P3"
    aTitoli(6) = "F.P4"
    aTitoli(7) = "F.P5"
    aTitoli(8) = "F.T"
    aTitoli(9) = "R.P1"
    aTitoli(10) = "R.P2"
    aTitoli(11) = "R.P3"
    aTitoli(12) = "R.P4"
    aTitoli(13) = "R.P5"
    aTitoli(14) = "R.Cr"
    aTitoli(15) = "RMax.P1"
    aTitoli(16) = "RMax.P2"
    aTitoli(17) = "RMax.P3"
    aTitoli(18) = "RMax.P4"
    aTitoli(19) = "RMax.P5"
    aTitoli(20) = "IRMax.P1"
    aTitoli(21) = "IRMax.P2"
    aTitoli(22) = "IRMax.P3"
    aTitoli(23) = "IRMax.P4"
    aTitoli(24) = "IRMax.P5"
End Sub
Sub alimentaArrayTabella(aRis,ruote,Num,freq1,freq2,freq3,freq4,freq5,freqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitMax1,IncRitMax2,IncRitMax3,IncRitMax4,IncRitMax5,ritT,FMax,RMax,RRMax,rIncMax)
    Dim aRit(5),aFreq(5),aRitMax(5),aIncRitMax(5)
    Dim i,j,z,w
    aRis(1) = ruote
    aRis(2) = Num
    aRis(3) = freq1
    aRis(4) = freq2
    aRis(5) = freq3
    aRis(6) = freq4
    aRis(7) = freq5
    aRis(8) = freqT
    aRis(9) = rit1
    aRis(10) = rit2
    aRis(11) = rit3
    aRis(12) = rit4
    aRis(13) = rit5
    aRis(14) = ritT
    aRis(15) = ritmax1
    aRis(16) = ritmax2
    aRis(17) = ritmax3
    aRis(18) = ritmax4
    aRis(19) = ritmax5
    aRis(20) = IncRitMax1
    aRis(21) = IncRitMax2
    aRis(22) = IncRitMax3
    aRis(23) = IncRitMax4
    aRis(24) = IncRitMax5
    ''''''''''''''''''''''''''''''''''''
    ' metto in array tutti i ritardi per posizione
    For i = 1 To 5
        aFreq(i) = aRis(i + 2)
    Next
    FMax = MassimoV(aFreq)
    For j = 1 To 5
        aRit(j) = aRis(j + 8)
    Next
    RMax = MassimoV(aRit)
    For z = 1 To 5
        aRitMax(z) = aRis(z + 14)
    Next
    RRMax = MassimoV(aRitMax)
    For w = 1 To 5
        aIncRitMax(w) = aRis(w + 19)
    Next
    rIncMax = MassimoV(aIncRitMax)
End Sub
Sub GetFormatCella(aRis,Fmax,Rmax,RRMax,rIncMax)
    Dim i,j,z,w
    Call SetColoreCella(2,RGB(254,241,199))
    For i = 3 To 7
        If aRis(i) = Fmax Then Call SetColoreCella(CInt(i),RGB(255,217,236))
    Next
    For j = 9 To 13
        If aRis(j) = aRis(14) Then Call SetColoreCella(CInt(j),RGB(230,255,234))
        If aRis(j) = Rmax Then Call SetColoreCella(CInt(j),vbRed)
    Next
    For z = 15 To 19
        If aRis(z) = RRMax Then Call SetColoreCella(CInt(z),RGB(166,210,225))
    Next
    For w = 20 To 24
        If rIncMax <> 0 Then
            If aRis(w) = rIncMax Then Call SetColoreCella(CInt(w),vbGreen)
        End If
    Next
    Call SetColoreCella(8,RGB(221,219,170))
    Call SetColoreCella(14,RGB(221,219,170))
End Sub
Sub GetIntestazione(aNum,aRuote)
    Scrivi "Disclaimer",True
    Scrivi "Il Gioco è vietato ai minori di anni 18,e, può comportare grave dipendenza patologica ",True,vbRed
    Scrivi ""
    Scrivi "Analisi di un  Numero su Ruota a scelta "
    Scrivi "Numeri analizzati : " & StringaNumeri(aNum,,True)
    Scrivi "Ruote analizzate  : " & StringaRuote(aRuote)
    Scrivi
End Sub
 
ciao i legend
ho appena acceso il pc
e mi sono trovato questa bella sorpresa... :))

a prima vista mi sembra tutto sia ok,
anzi molto molto meglio e fatto benissimo,
molto più di quanto mi aspettassi :)

controllerò poi bene se i risultati sono tutti corretti

davvero un grazie speciale per questo tuo lavoro

ciao
 
Ciao Paolo Felice che ti piaccia, controlla i risultati per favore, visto che lo script serve solo a te e anche a me :) almeno un riscontro sarebbe utile. ciao;)
 
Ottimo script ilegend . La tabella dell' incremento IRit.Max restituisce pero' tutti 0 . Si potrebbe fare anche per la sorte di Ambo nelle 10 Posizioni . 1-2 1-3 1-4 1-5 2-3 2-4 2-5 3-4 3-5 4-5 . Grazie dell' interessante script .

Ciao Eugenio
 
Ciao a tutti:) Grazie Rudi,e ,Eugenio. xEugenio: Mi spiace ma per quanto riguarda gli ambi sta costruendo un modulo apposito con tab analitico Luigi... x me va ben oltre :) Ciao a tutti
 
Ilegend l' arcano dovrebbe essere qui .

Codice: 
 Sub GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot)     Dim i     For i = 1 To 5         aPosTot(i) = True     Next     aPos1(1) = True     aPos2(2) = True     aPos3(3) = True     aPos4(4) = True     aPos5(5) = True End Sub

Dim i , z
For i = 1 To 4
For z = 2 To 5

Next
Next

Ciao Eugenio
 
ciao i legend
ancora grazie per l'ottimo script,
ti vorrei chiedere un altro script se ti è possibile,
non dovrebbe essere complicato, si tratta delle frequenze.

vorrei
poter vedere un elenco dei 90 numeri,
per trovare le loro frequenze in estrazioni
distanti 5, per BA.CA.FI.GE.MI.NA.PA.RO.TO.VE. NZ. TUTTE
da poter selezionare all'inizio,
cioè :
nelle ultime 5 estrazioni
nelle ultime 10 estrazioni
nelle ultime 15 estrazioni
nelle ultime 20 estrazioni
nelle ultime 25 estrazioni
nelle ultime 30 estrazioni
nelle ultime 35 estrazioni
nelle ultime 40 estrazioni
nelle ultime 45 estrazioni
nelle ultime 50 estrazioni


ti ringrazio anticipatamente per la tua disponibilità

fammi sapere

grazie

ciao
 
ciao Paolo quello che chiedi è davvero molto semplice.... Ciao Genios, la difficolta non sta nel combinare gli ambi che sono4005, cmq Luigi lo sta gia facendo) ciao Paolo Bisogna lanciare un inputbox, Ini,= mettere questO valorE nella funzione statestratto Provaci per favore , io sono qui
 
Ultima modifica:
i legend;n1892849 ha scritto:
controllare se lo script restituisce risultati corretti
lo script è richiesto da paolo, spero sia quanto richiesto
Codice: 
Option Explicit
Sub Main
' Controllare Se lo script restituisce output corretti
'Se si dovessero riscontrare eventuali bugs comunicarli
'Lo script è di natura statistica non restituisce previsioni
' script per Paolo su Lottoced
Dim x,y,j,i,z,w 'variabili contatore
Dim rit1,ritmax1,IncRitmax1,Freq1
Dim rit2,ritmax2,IncRitmax2,Freq2
Dim rit3,ritmax3,IncRitmax3,Freq3
Dim rit4,ritmax4,IncRitmax4,Freq4
Dim rit5,ritmax5,IncRitmax5,Freq5
Dim ritT,ritmaxT,IncRitmaxT,FreqT,aPosT
Dim RMax,FMax,RRMax,rIncMax
Dim Ruota,Num
Dim aTitoli(24),aPos1(5),aPos2(5),aPos3(5),aPos4(5),aPos5(5),aPosTot(5)
ReDim aRuote(0),aNum(0)
ScegliNumeri(aNum)
ScegliRuote(aRuote)
Call GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot)
Call GetTitoli(aTitoli)
Call InitTabella(aTitoli,RGB(192,192,192))

For x = 1 To UBound(aRuote)
Ruota = aRuote(x)
Call Messaggio("Sto calcolando la ruota di : " & Ruota)
Call AvanzamentoElab(1,12,Ruota)
For y = 1 To UBound(aNum)
Num = aNum(y)
Call StatEstratto(Ruota,Num,rit1,ritmax1,IncRitmax1,Freq1,,,,,aPos1)
Call StatEstratto(Ruota,Num,rit2,ritmax2,IncRitmax2,Freq2,,,,,aPos2)
Call StatEstratto(Ruota,Num,rit3,ritmax3,IncRitmax3,Freq3,,,,,aPos3)
Call StatEstratto(Ruota,Num,rit4,ritmax4,IncRitmax4,Freq4,,,,,aPos4)
Call StatEstratto(Ruota,Num,rit5,ritmax5,IncRitmax5,Freq5,,,,,aPos5)
Call StatEstratto(Ruota,Num,ritT,ritmaxT,IncRitmaxT,FreqT,,,,,aPosT)
ReDim aRis(24)
Call alimentaArrayTabella(aRis,SiglaRuota(Ruota),Num,Freq1,Freq2,Freq3,Freq4,Freq5,FreqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitmax1,IncRitmax2,IncRitmax3,IncRitmax4,IncRitmax5,ritT,FMax,RMax,RRMax,rIncMax)
Call AddRigaTabella(aRis)
Call GetFormatCella(aRis,FMax,RMax,RRMax,rIncMax)
Next
Next
Call GetIntestazione(aNum,aRuote)
Call CreaTabellaOrdinabile
End Sub
Sub GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot)
Dim i
For i = 1 To 5
aPosTot(i) = True
Next
aPos1(1) = True
aPos2(2) = True
aPos3(3) = True
aPos4(4) = True
aPos5(5) = True
End Sub
Sub GetTitoli(aTitoli)
aTitoli(1) = "Ruota"
aTitoli(2) = "Num.Ric."
aTitoli(3) = "F.P1"
aTitoli(4) = "F.P2"
aTitoli(5) = "F.P3"
aTitoli(6) = "F.P4"
aTitoli(7) = "F.P5"
aTitoli(8) = "F.T"
aTitoli(9) = "R.P1"
aTitoli(10) = "R.P2"
aTitoli(11) = "R.P3"
aTitoli(12) = "R.P4"
aTitoli(13) = "R.P5"
aTitoli(14) = "R.Cr"
aTitoli(15) = "RMax.P1"
aTitoli(16) = "RMax.P2"
aTitoli(17) = "RMax.P3"
aTitoli(18) = "RMax.P4"
aTitoli(19) = "RMax.P5"
aTitoli(20) = "IRMax.P1"
aTitoli(21) = "IRMax.P2"
aTitoli(22) = "IRMax.P3"
aTitoli(23) = "IRMax.P4"
aTitoli(24) = "IRMax.P5"
End Sub
Sub alimentaArrayTabella(aRis,ruote,Num,freq1,freq2,freq3,freq4,freq5,freqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitMax1,IncRitMax2,IncRitMax3,IncRitMax4,IncRitMax5,ritT,FMax,RMax,RRMax,rIncMax)
Dim aRit(5),aFreq(5),aRitMax(5),aIncRitMax(5)
Dim i,j,z,w
aRis(1) = ruote
aRis(2) = Num
aRis(3) = freq1
aRis(4) = freq2
aRis(5) = freq3
aRis(6) = freq4
aRis(7) = freq5
aRis(8) = freqT
aRis(9) = rit1
aRis(10) = rit2
aRis(11) = rit3
aRis(12) = rit4
aRis(13) = rit5
aRis(14) = ritT
aRis(15) = ritmax1
aRis(16) = ritmax2
aRis(17) = ritmax3
aRis(18) = ritmax4
aRis(19) = ritmax5
aRis(20) = IncRitMax1
aRis(21) = IncRitMax2
aRis(22) = IncRitMax3
aRis(23) = IncRitMax4
aRis(24) = IncRitMax5
''''''''''''''''''''''''''''''''''''
' metto in array tutti i ritardi per posizione
For i = 1 To 5
aFreq(i) = aRis(i + 2)
Next
FMax = MassimoV(aFreq)
For j = 1 To 5
aRit(j) = aRis(j + 8)
Next
RMax = MassimoV(aRit)
For z = 1 To 5
aRitMax(z) = aRis(z + 14)
Next
RRMax = MassimoV(aRitMax)
For w = 1 To 5
aIncRitMax(w) = aRis(w + 19)
Next
rIncMax = MassimoV(aIncRitMax)
End Sub
Sub GetFormatCella(aRis,Fmax,Rmax,RRMax,rIncMax)
Dim i,j,z,w
Call SetColoreCella(2,RGB(254,241,199))
For i = 3 To 7
If aRis(i) = Fmax Then Call SetColoreCella(CInt(i),RGB(255,217,236))
Next
For j = 9 To 13
If aRis(j) = aRis(14) Then Call SetColoreCella(CInt(j),RGB(230,255,234))
If aRis(j) = Rmax Then Call SetColoreCella(CInt(j),vbRed)
Next
For z = 15 To 19
If aRis(z) = RRMax Then Call SetColoreCella(CInt(z),RGB(166,210,225))
Next
For w = 20 To 24
If rIncMax <> 0 Then
If aRis(w) = rIncMax Then Call SetColoreCella(CInt(w),vbGreen)
End If
Next
Call SetColoreCella(8,RGB(221,219,170))
Call SetColoreCella(14,RGB(221,219,170))
End Sub
Sub GetIntestazione(aNum,aRuote)
Scrivi "Disclaimer",True
Scrivi "Il Gioco è vietato ai minori di anni 18,e, può comportare grave dipendenza patologica ",True,vbRed
Scrivi ""
Scrivi "Analisi di un Numero su Ruota a scelta "
Scrivi "Numeri analizzati : " & StringaNumeri(aNum,,True)
Scrivi "Ruote analizzate : " & StringaRuote(aRuote)
Scrivi
End Sub
Clicca per espandere...



OTTIMO, ma quale parametro si usa per poter giocare ?
 
Ultima modifica:
Ciao alien lo script restituisce la statistica degli estratti che vorresti verificare... Es teorico. voglio verificare i numeri 44.45.46 su ruota x lo script mi dice il ritardo e la frequenza di ogni singolo numero in ogni posizione;) Ciao
 
i legend;n1894409 ha scritto:
ciao Paolo quello che chiedi è davvero molto semplice.... Ciao Genios, la difficolta non sta nel combinare gli ambi che sono4005, cmq Luigi lo sta gia facendo) ciao Paolo Bisogna lanciare un inputbox, Ini,= mettere questO valorE nella funzione statestratto Provaci per favore , io sono qui
Clicca per espandere...

ciao i legend
davvero io non saprei da dove cominciare,
ti ringrazio per la fiducia :o

non ho nessuna conoscenza e nemmeno da dove si incomincia....

se vuoi darmi qualche dritta su come iniziare
a me farebbe molto piacere,
ma tieni conto (per farti un esempio) che io dovrei iniziare come
un bambino di 6 anni al primo giorno di scuola nella 1 elementare....
quindi non so ne quante lettere ci sono nell'alfabeto ne quali sono...
e nemmeno come sono e a cosa servono i numeri....

dimmi tu da dove cominciare,
dove trovare siti o documenti
da studiare e consultare.

grazie

ciao
 
Ciao Paolo, se ti interessa l argomento potresti cominciare a studiare gli scripts presenti su spaziometria
ora non riesco, Cmq entro stasera al massimo domani ti posto la modifica.
Ini : cint (inputbox ("inserisci quante estrazioni vuoi analizzare", "inizio analesi", 50))
Inizio:estrazionefin-ini
questo valore lo inseriamo in star estratto.
Ciao a dopo?
 
Ecco il nuovo script ho aggiunto una colonna in piu per il calcolo del ritaardo di posizione di 1° Livello
Codice: 
 Option Explicit Sub Main 	' Controllare Se lo script restituisce output corretti 	'Se si dovessero riscontrare eventuali bugs  comunicarli 	'Lo script è di natura statistica non restituisce previsioni 	' script per Paolo su Lottoced 	Dim x,y,j,i,z,w 'variabili contatore 	Dim rit1,ritmax1,IncRitmax1,Freq1 	Dim rit2,ritmax2,IncRitmax2,Freq2 	Dim rit3,ritmax3,IncRitmax3,Freq3 	Dim rit4,ritmax4,IncRitmax4,Freq4 	Dim rit5,ritmax5,IncRitmax5,Freq5 	Dim ritT,ritmaxT,IncRitmaxT,FreqT,aPosT 	Dim RMax,FMax,RRMax,rIncMax 	Dim Inizio,qEstr,Ruota,Num,rp1 	Dim aTitoli(25),aPos1(5),aPos2(5),aPos3(5),aPos4(5),aPos5(5),aPosTot(5) 	ReDim aRuote(0),aNum(0) 	If ImpostaParametri(qEstr,aNum,aRuote) = False Then 		Call MsgBox("i Parametri inseriti sono errati",vbCritical) 		Exit Sub 	End If 	Inizio = EstrazioneFin - qEstr 	Call GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot) 	Call GetTitoli(aTitoli) 	Call InitTabella(aTitoli,RGB(192,192,192)) 	For x = 1 To UBound(aRuote) 		Ruota = aRuote(x) 		For y = 1 To UBound(aNum) 			Num = aNum(y) 			Call Messaggio("Sto calcolando la ruota di : " & Ruota) 			Call AvanzamentoElab(1,90,Num) 			Call StatEstratto(Ruota,Num,rit1,ritmax1,IncRitmax1,Freq1,Inizio,,,,aPos1) 			Call StatEstratto(Ruota,Num,rit2,ritmax2,IncRitmax2,Freq2,Inizio,,,,aPos2) 			Call StatEstratto(Ruota,Num,rit3,ritmax3,IncRitmax3,Freq3,Inizio,,,,aPos3) 			Call StatEstratto(Ruota,Num,rit4,ritmax4,IncRitmax4,Freq4,Inizio,,,,aPos4) 			Call StatEstratto(Ruota,Num,rit5,ritmax5,IncRitmax5,Freq5,Inizio,,,,aPos5) 			Call StatEstratto(Ruota,Num,ritT,ritmaxT,IncRitmaxT,FreqT,Inizio,,,,aPosT) 			rp1 = RitPosTurbo(Num,Ruota,EstrazioneFin) 			ReDim aRis(25) 			Call alimentaArrayTabella(aRis,SiglaRuota(Ruota),Num,Freq1,Freq2,Freq3,Freq4,Freq5,FreqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitmax1,IncRitmax2,IncRitmax3,IncRitmax4,IncRitmax5,ritT,FMax,RMax,RRMax,rIncMax,rp1) 			Call AddRigaTabella(aRis) 			Call GetFormatCella(aRis,FMax,RMax,RRMax,rIncMax) 		Next 	Next 	Call GetIntestazione(qEstr,Inizio,aNum,aRuote) 	Call CreaTabellaOrdinabile End Sub Sub GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot) 	Dim i 	For i = 1 To 5 		aPosTot(i) = True 	Next 	aPos1(1) = True 	aPos2(2) = True 	aPos3(3) = True 	aPos4(4) = True 	aPos5(5) = True End Sub Sub GetTitoli(aTitoli) 	aTitoli(1) = "Ruota" 	aTitoli(2) = "Num.Ric." 	aTitoli(3) = "F.  I" 	aTitoli(4) = "F. II" 	aTitoli(5) = "F.III" 	aTitoli(6) = "F. IV" 	aTitoli(7) = "F.  V" 	aTitoli(8) = "F.T" 	aTitoli(9) = "R.  I" 	aTitoli(10) = "R. II" 	aTitoli(11) = "R.III" 	aTitoli(12) = "R. IV" 	aTitoli(13) = "R.  V" 	aTitoli(14) = "R.Cr" 	aTitoli(15) = "RMx.  I" 	aTitoli(16) = "RMx. II" 	aTitoli(17) = "RMx.III" 	aTitoli(18) = "RMx. IV" 	aTitoli(19) = "RMx.  V" 	aTitoli(20) = "IRMx.  I" 	aTitoli(21) = "IRMx. II" 	aTitoli(22) = "IRMx.III" 	aTitoli(23) = "IRMx. IV" 	aTitoli(24) = "IRMx.  V" 	aTitoli(25) = "RP1" End Sub Sub alimentaArrayTabella(aRis,ruote,Num,freq1,freq2,freq3,freq4,freq5,freqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitMax1,IncRitMax2,IncRitMax3,IncRitMax4,IncRitMax5,ritT,FMax,RMax,RRMax,rIncMax,rp1) 	Dim aRit(5),aFreq(5),aRitMax(5),aIncRitMax(5) 	Dim i,j,z,w 	aRis(1) = ruote 	aRis(2) = Num 	aRis(3) = freq1 	aRis(4) = freq2 	aRis(5) = freq3 	aRis(6) = freq4 	aRis(7) = freq5 	aRis(8) = freqT 	aRis(9) = rit1 	aRis(10) = rit2 	aRis(11) = rit3 	aRis(12) = rit4 	aRis(13) = rit5 	aRis(14) = ritT 	aRis(15) = ritmax1 	aRis(16) = ritmax2 	aRis(17) = ritmax3 	aRis(18) = ritmax4 	aRis(19) = ritmax5 	aRis(20) = IncRitMax1 	aRis(21) = IncRitMax2 	aRis(22) = IncRitMax3 	aRis(23) = IncRitMax4 	aRis(24) = IncRitMax5 	aRis(25) = rp1 	'''''''''''''''''''''''''''''''''''' 	' metto in array tutti i ritardi per posizione 	For i = 1 To 5 		aFreq(i) = aRis(i + 2) 	Next 	FMax = MassimoV(aFreq) 	For j = 1 To 5 		aRit(j) = aRis(j + 8) 	Next 	RMax = MassimoV(aRit) 	For z = 1 To 5 		aRitMax(z) = aRis(z + 14) 	Next 	RRMax = MassimoV(aRitMax) 	For w = 1 To 5 		aIncRitMax(w) = aRis(w + 19) 	Next 	rIncMax = MassimoV(aIncRitMax) End Sub Sub GetFormatCella(aRis,Fmax,Rmax,RRMax,rIncMax) 	Dim i,j,z,w 	Call SetColoreCella(2,RGB(254,241,199)) 	For i = 3 To 7 		If aRis(i) = Fmax Then Call SetColoreCella(CInt(i),RGB(255,217,236)) 	Next 	For j = 9 To 13 		If aRis(j) = aRis(14) Then Call SetColoreCella(CInt(j),RGB(230,255,234)) 		If aRis(j) = Rmax Then Call SetColoreCella(CInt(j),vbRed) 	Next 	For z = 15 To 19 		If aRis(z) = RRMax Then Call SetColoreCella(CInt(z),RGB(166,210,225)) 	Next 	For w = 20 To 24 		If rIncMax  0 Then 			If aRis(w) = rIncMax Then Call SetColoreCella(CInt(w),vbGreen) 		End If 	Next 	Call SetColoreCella(8,RGB(221,219,170)) 	Call SetColoreCella(14,RGB(221,219,170)) End Sub Sub GetIntestazione(qEstr,Inizio,aNum,aRuote) 	Scrivi "Disclaimer",True 	Scrivi "Il Gioco è vietato ai minori di anni 18,e, può comportare grave dipendenza patologica ",True,vbRed 	Scrivi "" 	Scrivi "Analisi di un  Numero su Ruota a scelta " 	Scrivi "" 	Scrivi "Inizio analisi Estrazioni : " & GetInfoEstrazione(Inizio) 	Scrivi "Estrazioni Analizzate     : " & qEstr 	Scrivi "Numeri analizzati         : " & StringaNumeri(aNum,,True) 	Scrivi "Ruote analizzate          : " & StringaRuote(aRuote) 	Scrivi End Sub Function ImpostaParametri(qEstr,aNum,aRuote) 	Dim bRet 	qEstr = CInt(InputBox("Analisi n Estrazioni","Estrazioni a Ritroso",EstrazioneFin)) 	If qEstr >= 0 And qEstr  0 Then 			ScegliRuote(aRuote) 			If UBound(aRuote) > 0 Then 				bRet = True 			End If 		End If 	End If 	ImpostaParametri = bRet End Function
 
Codice: 
Option Explicit
Sub Main
    ' Controllare Se lo script restituisce output corretti
    'Se si dovessero riscontrare eventuali bugs  comunicarli
    'Lo script è di natura statistica non restituisce previsioni
    ' script per Paolo su Lottoced
    Dim x,y,j,i,z,w 'variabili contatore
    Dim rit1,ritmax1,IncRitmax1,Freq1
    Dim rit2,ritmax2,IncRitmax2,Freq2
    Dim rit3,ritmax3,IncRitmax3,Freq3
    Dim rit4,ritmax4,IncRitmax4,Freq4
    Dim rit5,ritmax5,IncRitmax5,Freq5
    Dim ritT,ritmaxT,IncRitmaxT,FreqT,aPosT
    Dim RMax,FMax,RRMax,rIncMax
    Dim Inizio,qEstr,Ruota,Num,rp1
    Dim aTitoli(25),aPos1(5),aPos2(5),aPos3(5),aPos4(5),aPos5(5),aPosTot(5)
    ReDim aRuote(0),aNum(0)
    If ImpostaParametri(qEstr,aNum,aRuote) = False Then
        Call MsgBox("i Parametri inseriti sono errati",vbCritical)
        Exit Sub
    End If
    Inizio = EstrazioneFin - qEstr
    Call GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot)
    Call GetTitoli(aTitoli)
    Call InitTabella(aTitoli,RGB(192,192,192))
    For x = 1 To UBound(aRuote)
        Ruota = aRuote(x)
        For y = 1 To UBound(aNum)
            Num = aNum(y)
            Call Messaggio("Sto calcolando la ruota di : " & nomeruota(Ruota))
            Call AvanzamentoElab(1,90,Num)
            Call StatEstratto(Ruota,Num,rit1,ritmax1,IncRitmax1,Freq1,Inizio,,,,aPos1)
            Call StatEstratto(Ruota,Num,rit2,ritmax2,IncRitmax2,Freq2,Inizio,,,,aPos2)
            Call StatEstratto(Ruota,Num,rit3,ritmax3,IncRitmax3,Freq3,Inizio,,,,aPos3)
            Call StatEstratto(Ruota,Num,rit4,ritmax4,IncRitmax4,Freq4,Inizio,,,,aPos4)
            Call StatEstratto(Ruota,Num,rit5,ritmax5,IncRitmax5,Freq5,Inizio,,,,aPos5)
            Call StatEstratto(Ruota,Num,ritT,ritmaxT,IncRitmaxT,FreqT,Inizio,,,,aPosT)
            rp1 = RitPosTurbo(Num,Ruota,EstrazioneFin)
            ReDim aRis(25)
            Call alimentaArrayTabella(aRis,SiglaRuota(Ruota),Num,Freq1,Freq2,Freq3,Freq4,Freq5,FreqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitmax1,IncRitmax2,IncRitmax3,IncRitmax4,IncRitmax5,ritT,FMax,RMax,RRMax,rIncMax,rp1)
            Call AddRigaTabella(aRis)
            Call GetFormatCella(aRis,FMax,RMax,RRMax,rIncMax)
        Next
    Next
    Call GetIntestazione(qEstr,Inizio,aNum,aRuote)
    Call CreaTabellaOrdinabile
End Sub
Sub GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot)
    Dim i
    For i = 1 To 5
        aPosTot(i) = True
    Next
    aPos1(1) = True
    aPos2(2) = True
    aPos3(3) = True
    aPos4(4) = True
    aPos5(5) = True
End Sub
Sub GetTitoli(aTitoli)
    aTitoli(1) = "Ruota"
    aTitoli(2) = "Num.Ric."
    aTitoli(3) = "F.  I"
    aTitoli(4) = "F. II"
    aTitoli(5) = "F.III"
    aTitoli(6) = "F. IV"
    aTitoli(7) = "F.  V"
    aTitoli(8) = "F.T"
    aTitoli(9) = "R.  I"
    aTitoli(10) = "R. II"
    aTitoli(11) = "R.III"
    aTitoli(12) = "R. IV"
    aTitoli(13) = "R.  V"
    aTitoli(14) = "R.Cr"
    aTitoli(15) = "RMx.  I"
    aTitoli(16) = "RMx. II"
    aTitoli(17) = "RMx.III"
    aTitoli(18) = "RMx. IV"
    aTitoli(19) = "RMx.  V"
    aTitoli(20) = "IRMx.  I"
    aTitoli(21) = "IRMx. II"
    aTitoli(22) = "IRMx.III"
    aTitoli(23) = "IRMx. IV"
    aTitoli(24) = "IRMx.  V"
    aTitoli(25) = "RP1"
End Sub
Sub alimentaArrayTabella(aRis,ruote,Num,freq1,freq2,freq3,freq4,freq5,freqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitMax1,IncRitMax2,IncRitMax3,IncRitMax4,IncRitMax5,ritT,FMax,RMax,RRMax,rIncMax,rp1)
    Dim aRit(5),aFreq(5),aRitMax(5),aIncRitMax(5)
    Dim i,j,z,w
    aRis(1) = ruote
    aRis(2) = Num
    aRis(3) = freq1
    aRis(4) = freq2
    aRis(5) = freq3
    aRis(6) = freq4
    aRis(7) = freq5
    aRis(8) = freqT
    aRis(9) = rit1
    aRis(10) = rit2
    aRis(11) = rit3
    aRis(12) = rit4
    aRis(13) = rit5
    aRis(14) = ritT
    aRis(15) = ritmax1
    aRis(16) = ritmax2
    aRis(17) = ritmax3
    aRis(18) = ritmax4
    aRis(19) = ritmax5
    aRis(20) = IncRitMax1
    aRis(21) = IncRitMax2
    aRis(22) = IncRitMax3
    aRis(23) = IncRitMax4
    aRis(24) = IncRitMax5
    aRis(25) = rp1
    ''''''''''''''''''''''''''''''''''''
    ' metto in array tutti i ritardi per posizione
    For i = 1 To 5
        aFreq(i) = aRis(i + 2)
    Next
    FMax = MassimoV(aFreq)
    For j = 1 To 5
        aRit(j) = aRis(j + 8)
    Next
    RMax = MassimoV(aRit)
    For z = 1 To 5
        aRitMax(z) = aRis(z + 14)
    Next
    RRMax = MassimoV(aRitMax)
    For w = 1 To 5
        aIncRitMax(w) = aRis(w + 19)
    Next
    rIncMax = MassimoV(aIncRitMax)
End Sub
Sub GetFormatCella(aRis,Fmax,Rmax,RRMax,rIncMax)
    Dim i,j,z,w
    Call SetColoreCella(2,RGB(254,241,199))
    For i = 3 To 7
        If aRis(i) = Fmax Then Call SetColoreCella(CInt(i),RGB(255,217,236))
    Next
    For j = 9 To 13
        If aRis(j) = aRis(14) Then Call SetColoreCella(CInt(j),RGB(230,255,234))
        If aRis(j) = Rmax Then Call SetColoreCella(CInt(j),vbRed)
    Next
    For z = 15 To 19
        If aRis(z) = RRMax Then Call SetColoreCella(CInt(z),RGB(166,210,225))
    Next
    For w = 20 To 24
        If rIncMax <> 0 Then
            If aRis(w) = rIncMax Then Call SetColoreCella(CInt(w),vbGreen)
        End If
    Next
    Call SetColoreCella(8,RGB(221,219,170))
    Call SetColoreCella(14,RGB(221,219,170))
End Sub
Sub GetIntestazione(qEstr,Inizio,aNum,aRuote)
    Scrivi "Disclaimer",True
    Scrivi "Il Gioco è vietato ai minori di anni 18,e, può comportare grave dipendenza patologica ",True,vbRed
    Scrivi ""
    Scrivi "Analisi di un  Numero su Ruota a scelta "
    Scrivi ""
    Scrivi "Inizio analisi Estrazioni : " & GetInfoEstrazione(Inizio)
    Scrivi "Estrazioni Analizzate     : " & qEstr
    Scrivi "Numeri analizzati         : " & StringaNumeri(aNum,,True)
    Scrivi "Ruote analizzate          : " & StringaRuote(aRuote)
    Scrivi
End Sub
Function ImpostaParametri(qEstr,aNum,aRuote)
    Dim bRet
    qEstr = CInt(InputBox("Analisi n Estrazioni","Estrazioni a Ritroso",EstrazioneFin))
    If qEstr >= 0 And qEstr <= EstrazioneFin Then
        ScegliNumeri(aNum)
        If UBound(aNum) > 0 Then
            ScegliRuote(aRuote)
            If UBound(aRuote) > 0 Then
                bRet = True
            End If
        End If
    End If
    ImpostaParametri = bRet
End Function
 
ciao i legend ho provato quest'ultimo script, funziona bene ruota per ruota ma con la selezione "tutte" mi da errore potresti rivederlo ti ringrazio ancora per il tuo impegno e la tua cortesia ciao
 
Codice: 
Option Explicit
Sub Main
    ' Controllare Se lo script restituisce output corretti
    'Se si dovessero riscontrare eventuali bugs  comunicarli
    'Lo script è di natura statistica non restituisce previsioni
    ' script per Paolo su Lottoced
    Dim x,y,j,i,z,w 'variabili contatore
    Dim rit1,ritmax1,IncRitmax1,Freq1
    Dim rit2,ritmax2,IncRitmax2,Freq2
    Dim rit3,ritmax3,IncRitmax3,Freq3
    Dim rit4,ritmax4,IncRitmax4,Freq4
    Dim rit5,ritmax5,IncRitmax5,Freq5
    Dim ritT,ritmaxT,IncRitmaxT,FreqT,aPosT
    Dim RMax,FMax,RRMax,rIncMax
    Dim Inizio,qEstr,Ruota,Num,rp1
    Dim aTitoli(25),aPos1(5),aPos2(5),aPos3(5),aPos4(5),aPos5(5),aPosTot(5)
    ReDim aRuote(0),aNum(0)
    If ImpostaParametri(qEstr,aNum,aRuote) = False Then
        Call MsgBox("i Parametri inseriti sono errati",vbCritical)
        Exit Sub
    End If
    Inizio = EstrazioneFin - qEstr
    Call GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot)
    Call GetTitoli(aTitoli)
    Call InitTabella(aTitoli,RGB(192,192,192))
    For x = 1 To UBound(aRuote)
        Ruota = aRuote(x)
        For y = 1 To UBound(aNum)
            Num = aNum(y)
            Call Messaggio("Sto calcolando la ruota di : " & NomeRuota(Ruota))
            Call AvanzamentoElab(1,90,Num)
            If ScriptInterrotto Then Exit For
            Call StatEstratto(Ruota,Num,rit1,ritmax1,IncRitmax1,Freq1,Inizio,,,,aPos1)
            Call StatEstratto(Ruota,Num,rit2,ritmax2,IncRitmax2,Freq2,Inizio,,,,aPos2)
            Call StatEstratto(Ruota,Num,rit3,ritmax3,IncRitmax3,Freq3,Inizio,,,,aPos3)
            Call StatEstratto(Ruota,Num,rit4,ritmax4,IncRitmax4,Freq4,Inizio,,,,aPos4)
            Call StatEstratto(Ruota,Num,rit5,ritmax5,IncRitmax5,Freq5,Inizio,,,,aPos5)
            Call StatEstratto(Ruota,Num,ritT,ritmaxT,IncRitmaxT,FreqT,Inizio,,,,aPosT)
            If Ruota <> 11 Then
                rp1 = RitPosTurbo(Num,Ruota,EstrazioneFin)
            Else
                rp1 = "N.C."
            End If
            ReDim aRis(25)
            Call alimentaArrayTabella(aRis,SiglaRuota(Ruota),Num,Freq1,Freq2,Freq3,Freq4,Freq5,FreqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitmax1,IncRitmax2,IncRitmax3,IncRitmax4,IncRitmax5,ritT,FMax,RMax,RRMax,rIncMax,rp1)
            Call AddRigaTabella(aRis)
            Call GetFormatCella(aRis,FMax,RMax,RRMax,rIncMax)
        Next
    Next
    Call GetIntestazione(qEstr,Inizio,aNum,aRuote)
    Call CreaTabellaOrdinabile
End Sub
Sub GetPosizioni(aPos1,aPos2,aPos3,aPos4,aPos5,aPosTot)
    Dim i
    For i = 1 To 5
        aPosTot(i) = True
    Next
    aPos1(1) = True
    aPos2(2) = True
    aPos3(3) = True
    aPos4(4) = True
    aPos5(5) = True
End Sub
Sub GetTitoli(aTitoli)
    aTitoli(1) = "Ruota"
    aTitoli(2) = "Num.Ric."
    aTitoli(3) = "F.  I"
    aTitoli(4) = "F. II"
    aTitoli(5) = "F.III"
    aTitoli(6) = "F. IV"
    aTitoli(7) = "F.  V"
    aTitoli(8) = "F.T"
    aTitoli(9) = "R.  I"
    aTitoli(10) = "R. II"
    aTitoli(11) = "R.III"
    aTitoli(12) = "R. IV"
    aTitoli(13) = "R.  V"
    aTitoli(14) = "R.Cr"
    aTitoli(15) = "RMx.  I"
    aTitoli(16) = "RMx. II"
    aTitoli(17) = "RMx.III"
    aTitoli(18) = "RMx. IV"
    aTitoli(19) = "RMx.  V"
    aTitoli(20) = "IRMx.  I"
    aTitoli(21) = "IRMx. II"
    aTitoli(22) = "IRMx.III"
    aTitoli(23) = "IRMx. IV"
    aTitoli(24) = "IRMx.  V"
    aTitoli(25) = "RP1"
End Sub
Sub alimentaArrayTabella(aRis,ruote,Num,freq1,freq2,freq3,freq4,freq5,freqT,rit1,rit2,rit3,rit4,rit5,ritmax1,ritmax2,ritmax3,ritmax4,ritmax5,IncRitMax1,IncRitMax2,IncRitMax3,IncRitMax4,IncRitMax5,ritT,FMax,RMax,RRMax,rIncMax,rp1)
    Dim aRit(5),aFreq(5),aRitMax(5),aIncRitMax(5)
    Dim i,j,z,w
    aRis(1) = ruote
    aRis(2) = Num
    aRis(3) = freq1
    aRis(4) = freq2
    aRis(5) = freq3
    aRis(6) = freq4
    aRis(7) = freq5
    aRis(8) = freqT
    aRis(9) = rit1
    aRis(10) = rit2
    aRis(11) = rit3
    aRis(12) = rit4
    aRis(13) = rit5
    aRis(14) = ritT
    aRis(15) = ritmax1
    aRis(16) = ritmax2
    aRis(17) = ritmax3
    aRis(18) = ritmax4
    aRis(19) = ritmax5
    aRis(20) = IncRitMax1
    aRis(21) = IncRitMax2
    aRis(22) = IncRitMax3
    aRis(23) = IncRitMax4
    aRis(24) = IncRitMax5
    aRis(25) = rp1
    ''''''''''''''''''''''''''''''''''''
    ' metto in array tutti i ritardi per posizione
    For i = 1 To 5
        aFreq(i) = aRis(i + 2)
    Next
    FMax = MassimoV(aFreq)
    For j = 1 To 5
        aRit(j) = aRis(j + 8)
    Next
    RMax = MassimoV(aRit)
    For z = 1 To 5
        aRitMax(z) = aRis(z + 14)
    Next
    RRMax = MassimoV(aRitMax)
    For w = 1 To 5
        aIncRitMax(w) = aRis(w + 19)
    Next
    rIncMax = MassimoV(aIncRitMax)
End Sub
Sub GetFormatCella(aRis,Fmax,Rmax,RRMax,rIncMax)
    Dim i,j,z,w
    Call SetColoreCella(2,RGB(254,241,199))
    For i = 3 To 7
        If aRis(i) = Fmax Then Call SetColoreCella(CInt(i),RGB(255,217,236))
    Next
    For j = 9 To 13
        If aRis(j) = aRis(14) Then Call SetColoreCella(CInt(j),RGB(230,255,234))
        If aRis(j) = Rmax Then Call SetColoreCella(CInt(j),vbRed)
    Next
    For z = 15 To 19
        If aRis(z) = RRMax Then Call SetColoreCella(CInt(z),RGB(166,210,225))
    Next
    For w = 20 To 24
        If rIncMax <> 0 Then
            If aRis(w) = rIncMax Then Call SetColoreCella(CInt(w),vbGreen)
        End If
    Next
    Call SetColoreCella(8,RGB(221,219,170))
    Call SetColoreCella(14,RGB(221,219,170))
End Sub
Sub GetIntestazione(qEstr,Inizio,aNum,aRuote)
    Scrivi "Disclaimer",True
    Scrivi "Il Gioco è vietato ai minori di anni 18,e, può comportare grave dipendenza patologica ",True,vbRed
    Scrivi ""
    Scrivi "Analisi di un  Numero su Ruota a scelta "
    Scrivi ""
    Scrivi "Inizio analisi Estrazioni : " & GetInfoEstrazione(Inizio)
    Scrivi "Estrazioni Analizzate     : " & qEstr
    Scrivi "Numeri analizzati         : " & StringaNumeri(aNum,,True)
    Scrivi "Ruote analizzate          : " & StringaRuote(aRuote)
    Scrivi
End Sub
Function ImpostaParametri(qEstr,aNum,aRuote)
    Dim bRet
    qEstr = CInt(InputBox("Analisi n Estrazioni","Estrazioni a Ritroso",EstrazioneFin))
    If qEstr >= 0 And qEstr <= EstrazioneFin Then
        ScegliNumeri(aNum)
        If UBound(aNum) > 0 Then
            ScegliRuote(aRuote)
            If UBound(aRuote) > 0 Then
                bRet = True
            End If
        End If
    End If
    ImpostaParametri = bRet
End Function

la funzione del ritardo relativo funziona solo su ruota singola come è giusto che sia ,non gestisce le ruote tutte ,cmq forse questo modo risolve in maniera accettabile l'output,
vorrei inserire il ritardo comparato , ma aspetto lumi. dai miei tutor:)
 
Ciao Rudy:) Ciao Genios per ritardo relativo intendo il ritardo che si calcola con la funzione RitPos(,,,) presente in spaziometria.... è un parametro che rende la ricerca statistica ancora più completa.:) Ciao a tutti.
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 21 gennaio 2025
    Bari
    78
    09
    70
    03
    23
    Cagliari
    32
    88
    30
    13
    45
    Firenze
    87
    23
    15
    39
    86
    Genova
    71
    48
    67
    59
    23
    Milano
    58
    50
    80
    85
    29
    Napoli
    90
    81
    79
    82
    62
    Palermo
    70
    33
    90
    05
    10
    Roma
    15
    71
    55
    85
    76
    Torino
    89
    09
    18
    33
    69
    Venezia
    44
    80
    82
    73
    58
    Nazionale
    80
    25
    13
    63
    17
    Estrazione Simbolotto
    Bari
    39
    36
    34
    14
    31
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto