Script x Tom ,richiesta per LuigiB,Joe,Mike,Disaronno

i legend · 5 Luglio 2015

Ciao a tutti ho fatto un piccolo script per tom Vorrei che qualcuno lo verificasse nei suoi output
Chiedo a tutti gli amici come si sarebbe potuto ottenere lo stesso risultato scrivendo il tutto in un codice migliore e piu bello
Sono fissato con l'ottimizzazione, ma se non imparo da voi come potrei?
Grazie mille a tutti

Codice:

Option Explicit

i legend · 5 Luglio 2015

Ciao a tutti ho aggiunto alla tabella la colonna presenze da differenziarsi con quella frequenze
ecco il nuovo
il tasto modifica dell'editor non funziona

Codice:

Option Explicit
Sub Main

rudivall · 5 Luglio 2015

Grande Ilegend.....

Mike58 · 5 Luglio 2015

Bravo I Legend, mi sembra ben fatto e sicuramente ottimizzato al meglio, solo aggiungerei il anche il ritardo relativo alla combinazione per un ulteriore ordinamento e ricerca dati.

Anche per me Ottimo e di buon utilizzo.

ciao

i legend · 5 Luglio 2015

Ciao Rudy

grazie ciao Mike ,grazie,purtroppo non so come fare il ritardo relativo alla combinazione

Mike58 · 5 Luglio 2015

ciao I legend, è stato un gioco di parole per ritardo intentenvo ritardo e non RR ritardo relativo che comunque e facilmente implemetabile con il codice RitPos.
Mentre per il RSL se vedi qualche mio script recente l'ho già trattato e con una routine di Joe si arriva allo scopo con facilità.
Se vuoi possiamo vedere di mettere entrambi sul tuo script, ma avrebbe funzionalità solo per le combinazioni degli estratti.
Comunque ribadisco lo script è molto funzionale anche cosi.

Ciao

Mike58 · 5 Luglio 2015

intentevo solo questo, anche se tutto il resto può essere sicuramente utile.

Codice:

Option Explicit

Sub Main

'Script Frequenze_Combinazioni nei cicli su richiesta di lotto_tom75 :-)

' controllare evenuali bugs

'controllare le formule che ho utilizzato per calcolare l' inizio e fine ricerca se sono corrette potrei aver sbagliato,la testa fuma

'Se i riscontri statisci dovessero essere errati comunicarli per correggere il problema se possibile

Dim nCicli,LenCicli,Inizio,Fine

Dim idEstr,idesito,idComb

Dim I,j

Dim nColTot,sNum

Dim iPresenze,iNegativi

ReDim aNum(0),aRuote(0)

ReDim aCicli(0),aTitoli(0)

If ImpostaParametri(LenCicli,nCicli,aRuote,aNum,idComb,idesito,Inizio,Fine) = False Then

MsgBox "I Parametri inseriti sono ERRATI",vbCritical

Exit Sub

End If

Call Get_aTitoli(nCicli,LenCicli,Inizio,Fine,aCicli,aTitoli)

Call InitTabella(aTitoli)

Call GetIntestazione(nCicli,LenCicli,aNum,idComb,idesito,aRuote)

I = 0

nColTot = InitSviluppoIntegrale(aNum,idComb)

Do While GetCombSviluppo(aNum)

I = I + 1

Messaggio "Elaborazione in corso id sviluppo: " & I

AvanzamentoElab 1,nColTot,I

If ScriptInterrotto Then Exit Do

sNum = StringaNumeri(aNum,,True)

ReDim aRis(2)

Call alimentaArrayTab(aRis,I,sNum,nCicli,LenCicli,Inizio,Fine,aCicli,aNum,aRuote,idesito)

Call AddRigaTabella(aRis)

For j = 1 To nCicli

If aRis(j + 2) = 0 Then Call SetColoreCella(CInt(j + 2),RGB(255,243,204)) : Else Call SetColoreCella(CInt(j + 2),RGB(222,251,170))

Next

Loop

Call CreaTabellaOrdinabile

End Sub

Sub Get_aTitoli(nCicli,LenCicli,Inizio,Fine,aCicli,aTitoli)

Dim idEstr,m,i,j,n,k

ReDim aTitoli(2)

ReDim aCicli(0)

m = 0

For idEstr = Inizio To Fine Step LenCicli

m = m + 1

ReDim Preserve aCicli(m)

aCicli(m) = CStr(idEstr) & " - " & CStr(idEstr +(LenCicli - 1))

Next

aTitoli(1) = "IdComb"

aTitoli(2) = "aNumeri"

n = 2

For j = 1 To UBound(aCicli)

n = n + 1

ReDim Preserve aTitoli(n)

aTitoli(n) = aCicli(j)

Next

ReDim Preserve aTitoli(n + 4)

aTitoli(n + 1) = "Frequenze"

aTitoli(n + 2) = "Presenze"

aTitoli(n + 3) = "Assenze"

aTitoli(n + 4) = " Ritardo "

End Sub

Sub alimentaArrayTab(aRis,idComb,sNum,nCicli,LenCicli,Inizio,Fine,aCicli,aNum,aRuote,idEsito)

Dim n,idEstr,Inegativi,iPresenze,iFrequenze

aRis(1) = idComb

aRis(2) = sNum

n = 2

Inegativi = 0

iPresenze = 0

For idEstr = Inizio To Fine Step LenCicli

n = n + 1

ReDim Preserve aRis(n)

ReDim Preserve rit(1)

aRis(n) = SerieFreqTurbo(idEstr,idEstr +(LenCicli - 1),aNum,aRuote,idEsito)

rit(1) = SerieRitardoTurbo(EstrazioneIni,EstrazioneFin,aNum,aRuote,idEsito)

If CLng(aRis(n)) = 0 Then

Inegativi = Inegativi + 1

Else

iFrequenze = iFrequenze + CLng(aRis(n))

iPresenze = iPresenze + 1

End If

Next

ReDim Preserve aRis(n + 4)

aRis(n + 1) = iFrequenze

aRis(n + 2) = iPresenze

aRis(n + 3) = Inegativi

aRis(n + 4) = rit(1)

End Sub

Sub GetIntestazione(nCicli,LenCicli,aNum,idComb,idEsito,aRuote)

Call Scrivi("Il gioco è vietato ai minori di anni 18,e, può comportare grave dipendenza Patologica")

Call Scrivi("Verificare sempre anche da altre fonti che l'output restituito dallo script risulti corretto")

Call Scrivi

Call Scrivi

Call Scrivi("Inizio Analisi :")

Call Scrivi("Numero Cicli analizzati : " & nCicli)

Call Scrivi("Lunghezza Cicli : " & LenCicli)

Call Scrivi("Array Numeri : " & StringaNumeri(aNum,,True))

Call Scrivi("Sviluppoc Comb. : " & NomeCombinazione(idComb))

Call Scrivi("Sorte Analizzata : " & NomeEsito(idEsito))

Call Scrivi("Ruote analizzate : " & StringaRuote(aRuote,True))

Call Scrivi

End Sub

Function ImpostaParametri(LenCicli,nCicli,aRuote,aNum,idComb,idEsito,Inizio,Fine)

Dim bRet

LenCicli = CInt(InputBox("Inserire la lunghezza dei cicli ",,18))

If LenCicli > 0 Then

nCicli = CInt(InputBox("Inserire il numero dei cicli da " & LenCicli,,10))

If nCicli > 0 Then

ScegliRuote(aRuote)

If UBound(aRuote) > 0 Then

ScegliNumeri(aNum)

If UBound(aNum) > 0 Then

idComb = ScegliCombinazione

If UBound(aNum) >= idComb And idComb > 0 Then

idEsito = SelEsito

If idComb >= idEsito And idEsito > 0 Then

Inizio =(EstrazioneFin -(nCicli * LenCicli)) + 1

If Inizio >= 1 Then

Fine = EstrazioneFin -(LenCicli - 1)

If Fine <= EstrazioneFin Then

bRet = True

End If

End If

End If

End If

End If

End If

End If

End If

ImpostaParametri = bRet

End Function

Function NomeCombinazione(a)

Dim aVoci

aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine","Sestine","Settine","Ottine","Novine","Decine","Undicine","Dodicine","Tredicine","Quattordicine","Quindicine")

NomeCombinazione = aVoci(a)

End Function

Function ScegliCombinazione

Dim ret

Dim aVoci

aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine","Sestine","Settine","Ottine","Novine","Decine","Undicine","Dodicine","Tredicine","Quattordicine","Quindicine")

ret = ScegliOpzioneMenu(aVoci,1," Combina i numeri In :")

ScegliCombinazione = ret

End Function

Function SelEsito

Dim ret

Dim aVoci

aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")

ret = ScegliOpzioneMenu(aVoci,1," Analesi per Sorte di : ")

SelEsito = ret

End Function

Function NomeEsito(a)

Dim aVoci

aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")

NomeEsito = aVoci(a)

End Function

i legend · 6 Luglio 2015

ciao Mike come sempre il tuo aiuto è prezioso, mi hai fatto venire un idea per implementare lo script come lo vuole Tom, almeno credo

o per lo meno lo spero

grazie domani implemento e poi posto...
La tua proposta è interessante,se mi scrivi i link vado a studiare gli script, sono importanti per imparare
RSL sta ad indicare?
sicuramente è un parametro utile
a domani e grazie mille

Mike58 · 6 Luglio 2015

Ciao i Legend,non so definire RSL ritardo superiore di livello, ma probabilmente va a contare quando la cinquina in oggetto comincia a sfaldarsi.

Mentre il RR ritardo relativo conta da quando il numero in oggetto rimane solo dalla sua cinquina di origine.

I dati sono giusti mentre la spiegazione non saprei.

script di esempio

Codice:

Sub Main

Dim nu(1),ru(1)

Ini = EstrazioneFin - 200

fin = EstrazioneFin

r = 7

ru(1) = r

liv = 0 ' azzero contatore

a = NumeroPosRit(fin,r,1)'numero + ritartatario

b = RitPos(a,r,fin)' ritardo relativo

c = EstrattoRitardo(r,a,Ini,fin)' ritardo + ritardatario

'--------RSL-----------------------------------

rsl = fin - c ' estrazione di riferimento estratti con + ritardatario

nn = Split("0." & StringaEstratti(rsl,r),".")' ' split x estratti di riferimento

For p = 1 To 5

nu(1) = nn(p)

sp = SeriePrima(rsl + 1,fin,nu,ru,1)' trova il 1° numero sfaldato della cinquina

If liv <= sp Then liv = sp ' confronta

Next

'-----------fine Rsl----------------------------

Scrivi NomeRuota(r),1

Scrivi

Scrivi "Numero... " & a & " Ritardo : " & c

Scrivi "Ritardo Relativo : " & b

Scrivi "RSL : " & fin - liv

Scrivi "Aspettabilità = " & Round((fin - liv)/c,2)

End Sub

i legend · 6 Luglio 2015

Ciao Tom

che ne pensi? Ciao Mike

grazie per le funzioni, penso se riesco di inserirle nello script degli estratti in posizione

Codice:

i legend · 6 Luglio 2015

Ecco il newCode

controllare sempre eventuali bugs

Codice:

Option Explicit
Sub Main
    'Script Frequenze_Combinazioni nei cicli su richiesta di lotto_tom75 :-)
    ' controllare evenuali bugs
    'controllare le formule che ho utilizzato per calcolare l' inizio e fine ricerca se sono corrette potrei aver sbagliato,la testa fuma
    'Se i riscontri statisci dovessero essere errati comunicarli per correggere il problema se possibile
    Dim nCicli,LenCicli,Inizio,Fine
    Dim idEstr,idesito,idComb
    Dim i,nColTot,sNum
    Dim iPresenze,iNegativi
    ReDim aNum(0),aRuote(0),aCicli(0),aTitoli(0)
    If ImpostaParametri(LenCicli,nCicli,aRuote,aNum,idComb,idesito,Inizio,Fine) = False Then
        MsgBox "I Parametri inseriti sono ERRATI",vbCritical
        Exit Sub
    End If
    Call Get_aTitoli(nCicli,LenCicli,Inizio,Fine,aCicli,aTitoli)
    Call InitTabella(aTitoli,RGB(239,239,239),,,RGB(128,0,0))
    i = 0
    nColTot = InitSviluppoIntegrale(aNum,idComb)
    Call GetIntestazione(nCicli,LenCicli,aNum,idComb,idesito,aRuote,nColTot)
    Do While GetCombSviluppo(aNum)
        i = i + 1
        Messaggio "Elaborazione in corso id sviluppo: " & i
        AvanzamentoElab 1,nColTot,i
        If ScriptInterrotto Then Exit Do
        sNum = StringaNumeri(aNum,,True)
        ReDim aRis(2)
        Call alimentaArrayTab(aRis,i,sNum,nCicli,LenCicli,Inizio,Fine,aCicli,aNum,aRuote,idesito)
        Call AddRigaTabella(aRis)
        Call ColoraTabella(nCicli,aRis)
    Loop
    Call CreaTabellaOrdinabile
End Sub
Sub Get_aTitoli(nCicli,LenCicli,Inizio,Fine,aCicli,aTitoli)
    Dim idEstr,m,i,j,n,k
    ReDim aTitoli(2)
    ReDim aCicli(0)
    m = 0
    For idEstr = Inizio To Fine Step LenCicli
        m = m + 1
        ReDim Preserve aCicli(m)
        aCicli(m) = CStr(idEstr) & " - " & CStr(idEstr +(LenCicli - 1))
    Next
    aTitoli(1) = "IdComb"
    aTitoli(2) = "aNumeri"
    n = 2
    For j = 1 To UBound(aCicli)
        n = n + 1
        ReDim Preserve aTitoli(n)
        aTitoli(n) = aCicli(j)
    Next
    ReDim Preserve aTitoli(n + 9)
    aTitoli(n + 1) = "Freq.Cicli"
    aTitoli(n + 2) = "Pres.Cicli"
    aTitoli(n + 3) = "Asse.Cicli"
    aTitoli(n + 4) = "Rit.Cro. "
    aTitoli(n + 5) = "Rit.Sto. "
    aTitoli(n + 6) = "Sto.-Cro."
    aTitoli(n + 7) = "Cro./Sto."
    aTitoli(n + 8) = "incRit.Sto."
    aTitoli(n + 9) = "Fre.Global"
End Sub
Sub alimentaArrayTab(aRis,idComb,sNum,nCicli,LenCicli,Inizio,Fine,aCicli,aNum,aRuote,idEsito)
    Dim n,idEstr,Inegativi,iPresenze,iFrequenze
    Dim iRit,iRitMax,iIncr,iFreq
    aRis(1) = idComb
    aRis(2) = sNum
    n = 2
    Inegativi = 0
    iPresenze = 0
    iFrequenze = 0
    For idEstr = Inizio To Fine Step LenCicli
        n = n + 1
        ReDim Preserve aRis(n)
        ReDim Preserve rit(1)
        aRis(n) = SerieFreqTurbo(idEstr,idEstr +(LenCicli - 1),aNum,aRuote,idEsito)
        Call StatisticaFormazioneTurbo(aNum,aRuote,idEsito,iRit,iRitMax,iIncr,iFreq,EstrazioneIni,EstrazioneFin)
        If CLng(aRis(n)) = 0 Then
            Inegativi = Inegativi + 1
        Else
            iFrequenze = iFrequenze + CLng(aRis(n))
            iPresenze = iPresenze + 1
        End If
    Next
    ReDim Preserve aRis(n + 9)
    aRis(n + 1) = iFrequenze
    aRis(n + 2) = iPresenze
    aRis(n + 3) = Inegativi
    aRis(n + 4) = iRit
    aRis(n + 5) = iRitMax
    aRis(n + 6) = iRitMax - iRit
    aRis(n + 7) = Round(Dividi(iRit,iRitMax),2)
    aRis(n + 8) = iIncr
    aRis(n + 9) = iFreq
End Sub
Sub GetIntestazione(nCicli,LenCicli,aNum,idComb,idEsito,aRuote,nColTot)
    Call Scrivi("Il gioco è vietato ai minori di anni 18,e, può comportare grave dipendenza Patologica")
    Call Scrivi("Verificare sempre anche da altre fonti che l'output restituito dallo script risulti corretto")
    Call Scrivi
    Call Scrivi
    Call Scrivi("Inizio Analisi          :")
    Call Scrivi("Numero Cicli analizzati : " & nCicli)
    Call Scrivi("Lunghezza Cicli         : " & LenCicli)
    Call Scrivi("Array Numeri            : " & StringaNumeri(aNum,,True))
    Call Scrivi("Sviluppoc Comb.         : " & nColTot & " " & NomeCombinazione(idComb))
    Call Scrivi("Sorte Analizzata        : " & NomeEsito(idEsito))
    Call Scrivi("Ruote analizzate        : " & StringaRuote(aRuote,True))
    Call Scrivi
End Sub
Function ImpostaParametri(LenCicli,nCicli,aRuote,aNum,idComb,idEsito,Inizio,Fine)
    Dim bRet
    LenCicli = CInt(InputBox("Inserire la lunghezza dei cicli ",,18))
    If LenCicli > 0 Then
        nCicli = CInt(InputBox("Inserire il numero dei cicli da " & LenCicli,,10))
        If nCicli > 0 Then
            ScegliRuote(aRuote)
            If UBound(aRuote) > 0 Then
                ScegliNumeri(aNum)
                If UBound(aNum) > 0 Then
                    idComb = ScegliCombinazione
                    If UBound(aNum) >= idComb And idComb > 0 Then
                        idEsito = SelEsito
                        If idComb >= idEsito And idEsito > 0 Then
                            Inizio =(EstrazioneFin -(nCicli * LenCicli)) + 1
                            If Inizio >= 1 Then
                                Fine = EstrazioneFin -(LenCicli - 1)
                                If Fine <= EstrazioneFin Then
                                    bRet = True
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
    ImpostaParametri = bRet
End Function
Function NomeCombinazione(a)
    Dim aVoci
    aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine","Sestine","Settine","Ottine","Novine","Decine","Undicine","Dodicine","Tredicine","Quattordicine","Quindicine")
    NomeCombinazione = aVoci(a)
End Function
Function ScegliCombinazione
    Dim ret
    Dim aVoci
    aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine","Sestine","Settine","Ottine","Novine","Decine","Undicine","Dodicine","Tredicine","Quattordicine","Quindicine")
    ret = ScegliOpzioneMenu(aVoci,1," Combina i numeri In :")
    ScegliCombinazione = ret
End Function
Function SelEsito
    Dim ret
    Dim aVoci
    aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
    ret = ScegliOpzioneMenu(aVoci,1," Analesi per Sorte di : ")
    SelEsito = ret
End Function
Function NomeEsito(a)
    Dim aVoci
    aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
    NomeEsito = aVoci(a)
End Function
Sub ColoraTabella(nCicli,aRis)
    Dim i,j,k
    i = 3
    j = nCicli
    For k = i To nCicli + 2
        If aRis(k) = 0 Then Call SetColoreCella(CInt(k),RGB(255,243,204)) : Else Call SetColoreCella(CInt(k),RGB(222,251,170))
    Next
    i = k
    j = i + 2
    For k = i To j : Call SetColoreCella(CInt(k),RGB(255,223,255)) : Next
    i = k
    For k = i To UBound(aRis) : Call SetColoreCella(CInt(k),RGB(232,222,248)) : Next
End Sub

lotto_tom75 · 9 Luglio 2015

i legend;n1899275 ha scritto:
Ciao Tom che ne pensi? Ciao Mike grazie per le funzioni, penso se riesco di inserirle nello script degli estratti in posizione

Codice:

GRAZIE INFINITE i legend! Sempre bravissimo e scusa il ritardo nel risponderti ma l'ho visto solo ora!!!

. Lo devo ancora testare.. ma sicuramente sarà eccezionale!!! GRAZIE ANCORAAA mito!

platoon · 9 Luglio 2015

Ciao,grazie a tutti compresi gli scripters.
Volevo chiedere a lotto_tom75 o chi lo sa ,come si usa lo script,nel senso : nelle finestre che appaiono,cosa inserire in RUOTE e nelle successive? grazie

antonino · 22 Luglio 2015

Ciao sono interessato anch'io a quanto richiesto da Platoon. Grazie

nino

i legend · 22 Luglio 2015

Ciao le spigazioni le trovi nel 3d di tom una ventina interessante di tom in sezione sistemistica In pratica trovi le frequenze dei numeri da te scelti negli ultimi cicli da te scelti ciao

Cerca

Cerca

Script x Tom ,richiesta per LuigiB,Joe,Mike,Disaronno

i legend

Premium Member

i legend

Premium Member

rudivall

Advanced Member >PLATINUM<

Mike58

Advanced Member >PLATINUM PLUS<

i legend

Premium Member

Mike58

Advanced Member >PLATINUM PLUS<

Mike58

Advanced Member >PLATINUM PLUS<

i legend

Premium Member

Mike58

Advanced Member >PLATINUM PLUS<

i legend

Premium Member

i legend

Premium Member

lotto_tom75

Advanced Premium Member

platoon

Member

antonino

Super Member >PLATINUM<

i legend

Premium Member

Ultima estrazione Lotto

Ultimi Messaggi