REGALO-MODIFICA

[LOTTOLEON]

Sub Main()
Dim ambata(90,4)
Dim nn(3)
Dim ru(2)
Dim numeri(5)
Dim posta(2)
r=CInt(InputBox("Prima Ruota di ricerca?","SOMMASPY FREQUENZA BY LOTTOLEON",1))
r2=CInt(InputBox("Seconda Ruota di ricerca?","SOMMASPY FREQUENZA BY LOTTOLEON",2))
sp=CInt(InputBox("Somma Spia?","SOMMASPY FREQUENZA BY LOTTOLEON",90))
po=CInt(InputBox("Somma Spia in quale posizione?","SOMMASPY FREQUENZA BY LOTTOLEON",1))
ec=CInt(InputBox("Estrazione di Somma Spia?","SOMMASPY FREQUENZA BY LOTTOLEON",EstrazioneFin))
ei=CInt(InputBox("Quante estrazioni vuoi controllare?","SOMMASPY FREQUENZA BY LOTTOLEON",2000))
ab=CInt(InputBox("Quante Ambate vuoi giocare? [1-5]","SOMMASPY FREQUENZA BY LOTTOLEON",5))
c=CInt(InputBox("Ottimizzazione? [1-10]","SOMMASPY FREQUENZA BY LOTTOLEON",10))
ru(1)=r
ru(2)=r2
ef=EstrazioneFin-ec
For x=1 To 90
co=co+1
AvanzamentoElab 1,90,co
ambata(co,1)=co
ambata(co,2)=x
Next
fin=EstrazioneFin-ef
ini=EstrazioneFin-(ei+ef)
For es=ini To fin
If Fuori90(Estratto(es,r,po)+Estratto(es,r2,po))=eval(sp) Then
casi=casi+1
ex=es+1
ey=es+c
If ex>fin Then Exit For
If ey>fin Then ey=fin
Messaggio "Rilevata Somma spia "&Fuori90(Estratto(es,r,po)+Estratto(es,r2,po))&" il "& DataEstrazione(es)&" in "&po&" posizione su "& NomeRuota(r)&"-"& NomeRuota(r2)
For x=1 To 90
AvanzamentoElab 1,90,x
nn(1)=ambata(x,2)
ambata(x,4)=ambata(x,4)+ SerieFreq(ex,ey,nn,ru,1)
Next
End If
Next
OrdinaMatrice ambata,-1,4
ColoreTesto 2
Scrivi " - SOMMASPY FREQUENZA BY LOTTOLEON -",1
Scrivi : ColoreTesto 1
Scrivi "Somma Spia : "&Format2(sp)
Scrivi "Posizione Somma : "&po&"° posizione"
Scrivi "Ruote di ricerca : "& NomeRuota(r)&"-"& NomeRuota(r2)
Scrivi "Previsione valida dal : "& DataEstrazione(ec)
Scrivi "Periodo analisi : dal "& DataEstrazione(ini)&" al "&DataEstrazione(fin)
Scrivi "Estrazioni di ricerca : "& Format2(fin-ini)
Scrivi "Ottimizzazione : "& Format2(c)
Scrivi : ColoreTesto 0
Scrivi "---------------------------------------------------"
Scrivi "Rilevazione Somma Spia: "& Format2(casi)&" presenze in "&po&" posizione",1
Scrivi
Scrivi "Ambata --> "&Format2(ambata(1,2))&" Freq.: "&ambata(1,4)&" - Prob: "&Int((ambata(1,4)*10)/casi)&" %"
a1=ambata(1,2)
Scrivi "Ambata --> "&Format2(ambata(2,2))&" Freq.: "&ambata(2,4)&" - Prob: "&Int((ambata(2,4)*10)/casi)&" %"
a2=ambata(2,2)
Scrivi "Ambata --> "&Format2(ambata(3,2))&" Freq.: "&ambata(3,4)&" - Prob: "&Int((ambata(3,4)*10)/casi)&" %"
a3=ambata(3,2)
Scrivi "Ambata --> "&Format2(ambata(4,2))&" Freq.: "&ambata(4,4)&" - Prob: "&Int((ambata(4,4)*10)/casi)&" %"
a4=ambata(4,2)
Scrivi "Ambata --> "&Format2(ambata(5,2))&" Freq.: "&ambata(5,4)&" - Prob: "&Int((ambata(5,4)*10)/casi)&" %"
a5=ambata(5,2)
ult=EstrazioneFin
Scrivi
Scrivi "---------------------------------------------------"
Scrivi "---------------------------------------------------"
ColoreTesto 2
Scrivi
Scrivi " SIMULAZIONE SOMMASPY FREQUENZA BY LOTTOLEON",1
Scrivi : ColoreTesto 1
If ab=1 Then
Scrivi "Ambate in gioco : "& Format2(eval(a1))
End If
If ab=2 Then
Scrivi "Ambate in gioco : "& Format2(eval(a1))&"."&Format2(eval(a2))
End If
If ab=3 Then
Scrivi "Ambate in gioco : "& Format2(eval(a1))&"."&Format2(eval(a2))&"."& Format2(eval(a3))
End If
If ab=4 Then
Scrivi "Ambate in gioco : "& Format2(eval(a1))&"."&Format2(eval(a2))&"."& Format2(eval(a3))&"."& Format2(eval(a4))
End If
If ab=5 Then
Scrivi "Ambate in gioco : "& Format2(eval(a1))&"."&Format2(eval(a2))&"."& Format2(eval(a3))&"."& Format2(eval(a4))&"."& Format2(eval(a5))
End If
Scrivi "Ruote di gioco : "& NomeRuota(r)&"-"& NomeRuota(r2)
Scrivi "Periodo simulazione : dal "& DataEstrazione(ini)&" al "& DataEstrazione(ult)
Scrivi
ColoreTesto 0
posta(2)=10
For et=ini To EstrazioneFin
If Fuori90(Estratto(et,r,po)+Estratto(et,r2,po))=eval(sp) Then
Scrivi"--------------------------------------------------------------"
Scrivi "Somma Spia "& Format2(sp)&" su "& NomeRuota(r)&"-"& NomeRuota(r2)&" in data "& DataEstrazione(et),1
If ab=1 Then
numeri(1)=eval(a1)
End If
If ab=2 Then
numeri(1)=eval(a1)
numeri(2)=eval(a2)
End If
If ab=3 Then
numeri(1)=eval(a1)
numeri(2)=eval(a2)
numeri(3)=eval(a3)
End If
If ab=4 Then
numeri(1)=eval(a1)
numeri(2)=eval(a2)
numeri(3)=eval(a3)
numeri(4)=eval(a4)
End If
If ab=5 Then
numeri(1)=eval(a1)
numeri(2)=eval(a2)
numeri(3)=eval(a3)
numeri(4)=eval(a4)
numeri(5)=eval(a5)
End If
ImpostaGiocata 1,numeri,ru,posta,12,2
Gioca et
End If
Next
ScriviResoconto
End Sub

 

[LOTTOLEON]

Ciao a tutti

Cortesemente avrei bisogno di un piccola modifica a questo script

mi spiego, vorrei che il resoconto avvenga solo sulla ruota tutte,

tutto il resto rimane invariato

un saluto

 

[LOTTOLEON]

Ciao nessuno che mi puo' aiutare per la modifica sopra citata

 

[swan]

ciao penso sia sufficente sustituire questa riga

ru(1)=r
ru(2)=r2

con
ru(1)=11
dovrebbe funzionare
ciao

 

[Lucax]

Caro LOTTOLEON! Copiato paro paro da un listato di Aragon di qualche anno fa! Se lo hai fatto tu perchè chiedi ad altri di modificarlo?

 

[claudio8]

ho inserito un inputbox per scegliere la ruota di gioco....

Sub Main()
    Dim ambata(90,4)
    Dim nn(3)
    Dim ru(2),rg(1)
    Dim numeri(5)
    Dim posta(2)
    r = CInt(InputBox("Prima Ruota di ricerca?","SOMMASPY FREQUENZA BY LOTTOLEON",1))
    r2 = CInt(InputBox("Seconda Ruota di ricerca?","SOMMASPY FREQUENZA BY LOTTOLEON",2))
    sp = CInt(InputBox("Somma Spia?","SOMMASPY FREQUENZA BY LOTTOLEON",90))
    po = CInt(InputBox("Somma Spia in quale posizione?","SOMMASPY FREQUENZA BY LOTTOLEON",1))
    ec = CInt(InputBox("Estrazione di Somma Spia?","SOMMASPY FREQUENZA BY LOTTOLEON",EstrazioneFin))
    ei = CInt(InputBox("Quante estrazioni vuoi controllare?","SOMMASPY FREQUENZA BY LOTTOLEON",2000))
    ab = CInt(InputBox("Quante Ambate vuoi giocare? [1-5]","SOMMASPY FREQUENZA BY LOTTOLEON",5))
    c = CInt(InputBox("Ottimizzazione? [1-10]","SOMMASPY FREQUENZA BY LOTTOLEON",10))
    rgioco = CInt(InputBox("Ruota di Gioco? [1-12]","SOMMASPY FREQUENZA BY LOTTOLEON",11)) ' 11= tutte
    rg(1) = rgioco
    ru(1) = r
    ru(2) = r2
    ef = EstrazioneFin - ec
    For x = 1 To 90
        co = co + 1
        AvanzamentoElab 1,90,co
        ambata(co,1) = co
        ambata(co,2) = x
    Next
    fin = EstrazioneFin - ef
    ini = EstrazioneFin -(ei + ef)
    For es = ini To fin
        If Fuori90(Estratto(es,r,po) + Estratto(es,r2,po)) = eval(sp) Then
            casi = casi + 1
            ex = es + 1
            ey = es + c
            If ex > fin Then Exit For
            If ey > fin Then ey = fin
            Messaggio "Rilevata Somma spia " & Fuori90(Estratto(es,r,po) + Estratto(es,r2,po)) & " il " & DataEstrazione(es) & " in " & po & " posizione su " & NomeRuota(r) & "-" & NomeRuota(r2)
            For x = 1 To 90
                AvanzamentoElab 1,90,x
                nn(1) = ambata(x,2)
                ambata(x,4) = ambata(x,4) + SerieFreq(ex,ey,nn,ru,1)
            Next
        End If
    Next
    OrdinaMatrice ambata,- 1,4
    ColoreTesto 2
    Scrivi " - SOMMASPY FREQUENZA BY LOTTOLEON -",1
    Scrivi : ColoreTesto 1
    Scrivi "Somma Spia : " & Format2(sp)
    Scrivi "Posizione Somma : " & po & "° posizione"
    Scrivi "Ruote di ricerca : " & NomeRuota(r) & "-" & NomeRuota(r2)
    Scrivi "Previsione valida dal : " & DataEstrazione(ec)
    Scrivi "Periodo analisi : dal " & DataEstrazione(ini) & " al " & DataEstrazione(fin)
    Scrivi "Estrazioni di ricerca : " & Format2(fin - ini)
    Scrivi "Ottimizzazione : " & Format2(c)
    Scrivi : ColoreTesto 0
    Scrivi "---------------------------------------------------"
    Scrivi "Rilevazione Somma Spia: " & Format2(casi) & " presenze in " & po & " posizione",1
    Scrivi
    Scrivi "Ambata --> " & Format2(ambata(1,2)) & " Freq.: " & ambata(1,4) & " - Prob: " & Int((ambata(1,4)*10)/casi) & " %"
    a1 = ambata(1,2)
    Scrivi "Ambata --> " & Format2(ambata(2,2)) & " Freq.: " & ambata(2,4) & " - Prob: " & Int((ambata(2,4)*10)/casi) & " %"
    a2 = ambata(2,2)
    Scrivi "Ambata --> " & Format2(ambata(3,2)) & " Freq.: " & ambata(3,4) & " - Prob: " & Int((ambata(3,4)*10)/casi) & " %"
    a3 = ambata(3,2)
    Scrivi "Ambata --> " & Format2(ambata(4,2)) & " Freq.: " & ambata(4,4) & " - Prob: " & Int((ambata(4,4)*10)/casi) & " %"
    a4 = ambata(4,2)
    Scrivi "Ambata --> " & Format2(ambata(5,2)) & " Freq.: " & ambata(5,4) & " - Prob: " & Int((ambata(5,4)*10)/casi) & " %"
    a5 = ambata(5,2)
    ult = EstrazioneFin
    Scrivi
    Scrivi "---------------------------------------------------"
    Scrivi "---------------------------------------------------"
    ColoreTesto 2
    Scrivi
    Scrivi " SIMULAZIONE SOMMASPY FREQUENZA BY LOTTOLEON",1
    Scrivi : ColoreTesto 1
    If ab = 1 Then
        Scrivi "Ambate in gioco : " & Format2(eval(a1))
    End If
    If ab = 2 Then
        Scrivi "Ambate in gioco : " & Format2(eval(a1)) & "." & Format2(eval(a2))
    End If
    If ab = 3 Then
        Scrivi "Ambate in gioco : " & Format2(eval(a1)) & "." & Format2(eval(a2)) & "." & Format2(eval(a3))
    End If
    If ab = 4 Then
        Scrivi "Ambate in gioco : " & Format2(eval(a1)) & "." & Format2(eval(a2)) & "." & Format2(eval(a3)) & "." & Format2(eval(a4))
    End If
    If ab = 5 Then
        Scrivi "Ambate in gioco : " & Format2(eval(a1)) & "." & Format2(eval(a2)) & "." & Format2(eval(a3)) & "." & Format2(eval(a4)) & "." & Format2(eval(a5))
    End If
    Scrivi "Ruote di gioco : " & NomeRuota(r) & "-" & NomeRuota(r2)
    Scrivi "Periodo simulazione : dal " & DataEstrazione(ini) & " al " & DataEstrazione(ult)
    Scrivi
    ColoreTesto 0
    posta(2) = 10
    For et = ini To EstrazioneFin
        If Fuori90(Estratto(et,r,po) + Estratto(et,r2,po)) = eval(sp) Then
            Scrivi"--------------------------------------------------------------"
            Scrivi "Somma Spia " & Format2(sp) & " su " & NomeRuota(r) & "-" & NomeRuota(r2) & " in data " & DataEstrazione(et),1
            If ab = 1 Then
                numeri(1) = eval(a1)
            End If
            If ab = 2 Then
                numeri(1) = eval(a1)
                numeri(2) = eval(a2)
            End If
            If ab = 3 Then
                numeri(1) = eval(a1)
                numeri(2) = eval(a2)
                numeri(3) = eval(a3)
            End If
            If ab = 4 Then
                numeri(1) = eval(a1)
                numeri(2) = eval(a2)
                numeri(3) = eval(a3)
                numeri(4) = eval(a4)
            End If
            If ab = 5 Then
                numeri(1) = eval(a1)
                numeri(2) = eval(a2)
                numeri(3) = eval(a3)
                numeri(4) = eval(a4)
                numeri(5) = eval(a5)
            End If
            ImpostaGiocata 1,numeri,rg,posta,12,2
            Gioca et
        End If
    Next
    ScriviResoconto
End Sub

 

[claudio8]

ciao penso sia sufficente sustituire questa riga

ru(1)=r
ru(2)=r2

con
ru(1)=11
dovrebbe funzionare
ciao

swan, se cambia quelle righe, non può + avere le ruote di ricerca.
Occorre definire una nuova array che ho chiamato "rg", che utilizzerà il valore insrerito nell' inputbox specifico aggiunto, da dare in pasto alla funzione Impostagiocata.
Un saluto a tutti "Boss" compreso.

 

[LOTTOLEON]

Grazie claudio8 ottimo

Lucax mi piaceva far scriver il mio nickname

 

[LOTTOLEON]

Qualcosa lo fa lo script qualcosa dobbiamo fare noi!!

per dare il colpo di grazia alla lottomatica

vorrei aggiungere un InputBox dove io inserisco dei numeri per abbinamento per ambo secco alle ambate che fornisce lo script

ciao e grazie

 

[claudio8]

Lottoleon, visto che "l'appetito viene mangiando", ti suggerisco di usare questo script di Luigi per restringere la giocata che ti prospetti di fare.
Devi solo scegliere la spia (singolo numero) e la ruota. Lo script ti darà direttamente gli ambi + frequenti dopo la spia.
es:
1 -posiziona il fine range estrazioni di spaziometria al 3/11/2015 in modo da escludere le estrazioni successive dal calcolo dello script ;
2 - fai la ricerca con la spia 20 = 1° estratto della estrazione di bari del 5/11/2015.
3 - controlla l'esito dell'analisi fatta dallo script e vedrai che l'ambo + frequente indicatoti (14.84) da l'esito al secondo colpo con un elemento del 3° ambo + frequente ( 4 ).
Attenzione che non è sempre "NATALE"

Option Explicit
Class clsAmbo
    Private aNumeri(2)
    Private m_Presenze
    Private m_Key
    Private m_Ritardo
    Private m_RitardoMax
    
    Public Property Let Key(v)
        m_Key = v
    End Property
    Public Property Get Key()
        Key = m_Key
    End Property
    Public Property Get Presenze()
        Presenze = m_Presenze
    End Property
    Public Property Let Presenze(v)
        m_Presenze = v
    End Property
    Public Property Get NumeriString
        NumeriString = StringaNumeri(aNumeri,,True)
    End Property
    Public Property Get Ritardo
        Ritardo = m_Ritardo
    End Property
    Public Property Get RitardoMax
        RitardoMax = m_RitardoMax
    End Property
    
    Sub SetNumero(id,Numero)
        aNumeri(id) = Numero
    End Sub
    Sub StatisticaAmbo(nInizio,nFine,nRuota)
        ReDim aRuota(1)
        aRuota(1) = nRuota
        Call StatisticaFormazione(aNumeri,aRuota,2,m_Ritardo,m_RitardoMax,0,0,nInizio,nFine)
    End Sub
End Class
Class clsEstrazione
    Private m_collAmbi
    Private m_IdEst
    Private m_Inizio
    Private m_Fine
    Public Property Get Inizio
        Inizio = m_Inizio
    End Property
    Public Property Let Inizio(v)
        m_Inizio = v
    End Property
    Public Property Get Fine
        Fine = m_Fine
    End Property
    Public Property Let Fine(v)
        m_Fine = v
    End Property
    Public Property Get CollAmbi
        Set CollAmbi = m_collAmbi
    End Property
    Public Property Let IdEst(v)
        m_IdEst = v
    End Property
    Public Property Get IdEst()
        IdEst = m_IdEst
    End Property
    Sub Init(idEstr)
        Set m_collAmbi = GetNewCollection
        m_IdEst = idEstr
        m_Inizio = idEstr + 1
    End Sub
    Sub AddAmbo(aColonne,idColonna)
        Dim cAmbo
        Dim sKey
        sKey = "k" & Format2(aColonne(idColonna,1)) & "-" & Format2(aColonne(idColonna,2))
        Set cAmbo = GetItem(sKey,m_collAmbi)
        If cAmbo Is Nothing Then
            Set cAmbo = New clsAmbo
            Call cAmbo.SetNumero(1,aColonne(idColonna,1))
            Call cAmbo.SetNumero(2,aColonne(idColonna,2))
            cAmbo.Presenze = 1
            cAmbo.key = sKey
            m_collAmbi.Add cAmbo,sKey
        Else
            cAmbo.Presenze = cAmbo.Presenze + 1
        End If
    End Sub
    Function IsAmboPresente(sKey)
        Dim cAmbo
        Set cAmbo = GetItem(sKey,m_collAmbi)
        If Not(cAmbo Is Nothing) Then
            IsAmboPresente = True
        End If
    End Function
    Function GetAmboPiuFreq(nRetFrq)
        Dim cAmbo
        If m_collAmbi.count > 0 Then
            Call OrdinaItemCollection(m_collAmbi,"Presenze")
            Set cAmbo = m_collAmbi(1)
            GetAmboPiuFreq = cAmbo.NumeriString
            nRetFrq = cAmbo.Presenze
        Else
            GetAmboPiuFreq = ""
        End If
    End Function
End Class
Sub Main
    Dim nSpia
    Dim nInizio,nFine,nColpi
    Dim idEstr,k,e,i
    Dim nRuota
    Dim aColonne
    Dim cAmbo,cEstr
    Dim sKey
    Dim CollAmbi
    Dim CollEstrazioni
    Dim CollAmbiTot
    Dim bTrovato
    Dim nEs
    Const RigheMaxTabAmbiFreq = 20
    Const RigheMaxTabCopertura = 20
    Const RigheMaxRiepilogo = 20
    nSpia = CInt(InputBox("Inserisci Numero Spia",,20))
    nColpi = CInt(InputBox("Inserisci colpi",,6))
    nEs = CInt(InputBox("n° estrazioni di controllo",,2000))

    nInizio = EstrazioneFin - nEs
    nFine = EstrazioneFin
    nRuota = ScegliRuota
    Set CollAmbi = GetNewCollection
    Set CollEstrazioni = GetNewCollection
    Set CollAmbiTot = GetNewCollection
    If isNumeroValidoLotto(nSpia) And nColpi > 0 And nRuota > 0 Then
        For idEstr = nInizio To nFine
            bTrovato = IsNumeroPresenteInEstrazione(idEstr,nRuota,nSpia,0)
            If bTrovato Then
                Set cEstr = New clsEstrazione
                Call cEstr.Init(idEstr)
                For i = idEstr + 1 To idEstr + nColpi
                    ReDim aNum(5)
                    Call GetArrayNumeriRuota(i,nRuota,aNum)
                    If aNum(1) > 0 Then
                        Call OrdinaMatrice(aNum,1)
                        aColonne = SviluppoIntegrale(aNum,2)
                        For k = 1 To UBound(aColonne)
                            Call cEstr.AddAmbo(aColonne,k)
                            sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
                            Set cAmbo = GetItem(sKey,CollAmbi)
                            If cAmbo Is Nothing Then
                                Set cAmbo = New clsAmbo
                                cAmbo.key = sKey
                                Call cAmbo.SetNumero(1,aColonne(k,1))
                                Call cAmbo.SetNumero(2,aColonne(k,2))
                                cAmbo.Presenze = 1
                                CollAmbi.Add cAmbo,sKey
                            Else
                                cAmbo.Presenze = cAmbo.Presenze + 1
                            End If
                        Next
                    End If
                    cEstr.fine = i
                    If IsNumeroPresenteInEstrazione(i,nRuota,nSpia,0) Then
                        idEstr = i - 1
                        Exit For
                    End If
                Next
                CollEstrazioni.Add cEstr,"k" & cEstr.idEst
            End If
            Call AvanzamentoElab(nInizio,nFine,idEstr)
            If ScriptInterrotto Then Exit For
        Next
        Call OrdinaItemCollection(CollAmbi,"Presenze","Key")
        Call CalcolaCopertura(CollAmbiTot,CollEstrazioni)
        Call CreaTabRiepilogo(CollAmbi,CollAmbiTot,CollEstrazioni.count,nInizio,nFine,nRuota,RigheMaxRiepilogo)

        Call CreaTabPresenze(CollAmbi,RigheMaxTabAmbiFreq)
        Call CreaTabCopertura(CollAmbiTot,CollEstrazioni,RigheMaxTabCopertura)
        Call CreaTabCasiRilevati(CollEstrazioni,nSpia,nColpi,nRuota,nInizio,nFine)
    End If
End Sub
Function GetItem(sKey,CollAmbi)
    On Error Resume Next
    Set GetItem = Nothing
    Set GetItem = CollAmbi(sKey)
End Function
Sub AlimentaCollAmbiTot(collAmbi)
    Dim k,sKey
    ReDim aNum(90)
    Dim aColonne
    Dim cAmbo
    For k = 1 To 90
        aNum(k) = k
    Next
    aColonne = SviluppoIntegrale(aNum,2)
    For k = 1 To UBound(aColonne)
        sKey = "k" & Format2(aColonne(k,1)) & "-" & Format2(aColonne(k,2))
        Set cAmbo = New clsAmbo
        cAmbo.key = sKey
        Call cAmbo.SetNumero(1,aColonne(k,1))
        Call cAmbo.SetNumero(2,aColonne(k,2))
        cAmbo.Presenze = 0
        collAmbi.Add cAmbo,sKey
    Next
End Sub
Sub GetColoriRiga(aColori,nColDaEvid,ColoreLastCol)
    ReDim aColori(12)
    Dim k
    For k = 1 To 12
        If k = nColDaEvid Then
            aColori(k) = vbYellow
        Else
            aColori(k) = vbWhite
        End If
    Next
    aColori(12) = ColoreLastCol
End Sub
Sub CalcolaCopertura(CollAmbiTot,CollEstrazioni)
    Dim cAmbo
    Dim k
    Dim cEstr
    ' tabella copertura
    Call Messaggio("Calcolo copertura estrazioni")
    Call AlimentaCollAmbiTot(CollAmbiTot)
    k = 0
    For Each cAmbo In CollAmbiTot
        For Each cEstr In CollEstrazioni
            If cEstr.IsAmboPresente(cAmbo.key) Then
                cAmbo.presenze = cAmbo.presenze + 1
            End If
        Next
        k = k + 1
        Call AvanzamentoElab(1,CollAmbiTot.count,k)
        If ScriptInterrotto Then Exit For
    Next
    
End Sub
Sub CreaTabCopertura(CollAmbiTot,CollEstrazioni,nRigheMax)
    Dim cAmbo
    Dim k
    Dim cEstr
    
    Call OrdinaItemCollection(CollAmbiTot,"Presenze","Key")
    
    Call Scrivi("La seguente tabella indica la copertura degli ambi sulle estrazioni rilevate dai casi (" & CollEstrazioni.count & " casi)")
    Call Scrivi
    ' tabella copertura
    ReDim aTitoli(3)
    aTitoli(1) = "Ambo"
    aTitoli(2) = "Estrazioni Coperte"
    aTitoli(3) = "Percentuale"
    Call InitTabella(aTitoli)
    For Each cAmbo In CollAmbiTot
        If cAmbo.presenze > 0 Then
            ReDim aValori(3)
            aValori(1) = cAmbo.NumeriString
            aValori(2) = cAmbo.presenze
            aValori(3) = Round(Dividi((cAmbo.presenze * 100),CollEstrazioni.count),3) & " %"
            Call AddRigaTabella(aValori)
        End If
    Next
    Call Messaggio("Creazione tabella in corso ...")
    Call CreaTabella(,,,nRigheMax)
End Sub
Sub CreaTabPresenze(CollAmbi,nRigheMax)
    Dim cAmbo
    ' tabella presenze
    Call Scrivi("La seguente tabella indica la frequenza degli ambi")
    Call Scrivi
    'Call OrdinaItemCollection(CollAmbi,"Presenze")
    ReDim aTitoli(2)
    aTitoli(1) = "Ambo"
    aTitoli(2) = "Presenze"
    Call InitTabella(aTitoli)
    For Each cAmbo In CollAmbi
        ReDim aValori(2)
        aValori(1) = cAmbo.NumeriString
        aValori(2) = cAmbo.presenze
        Call AddRigaTabella(aValori)
    Next
    Call Messaggio("Creazione tabella in corso ...")
    Call CreaTabella(,,,nRigheMax)
End Sub
    'nInizio = EstrazioneFin - nes
    'nFine = EstrazioneFin
    'nRuota = ScegliRuota

Sub CreaTabCasiRilevati(CollEstrazioni,nSpia,nColpi,nRuota,nInizio,nFine)
    Dim i,k,n,nPosSpia,nFreq
    Dim cEstr
    ' tabella casi rilevati
    Call Scrivi("La seguente tabella indica i casi rilevati (" & CollEstrazioni.count & " casi)sulla ruota di " & SiglaRuota(nRuota) & " dal "& DataEstrazione(nInizio) & " a " & DataEstrazione(nFine))
    Call Scrivi
    Call Messaggio("Riepilogo  casi rilevati")
    ReDim aTitoli(12)
    aTitoli(1) = "Estrazione"
    aTitoli(2) = "Data"
    aTitoli(3) = "I"
    aTitoli(4) = "II"
    aTitoli(5) = "III"
    aTitoli(6) = "IV"
    aTitoli(7) = "V"
    aTitoli(8) = "Ambo Piu Frequente"
    aTitoli(9) = "Presenze"
    aTitoli(10) = "InizioAnalisi"
    aTitoli(11) = "FineAnalisi"
    aTitoli(12) = "EstrazioniSuccessive"
    i = 0
    Call InitTabella(aTitoli)
    For Each cEstr In CollEstrazioni
        ReDim aValori(12)
        aValori(1) = cEstr.idEst
        aValori(2) = DataEstrazione(cEstr.idEst)
        nPosSpia = 0
        For k = 1 To 5
            n = Estratto(cEstr.idEst,nRuota,k)
            aValori(k + 2) = n
            If n = nSpia Then
                nPosSpia = k
            End If
        Next
        aValori(8) = cEstr.GetAmboPiuFreq(nFreq)
        aValori(9) = nFreq
        aValori(10) = cEstr.Inizio
        aValori(11) = cEstr.Fine
        aValori(12) = cEstr.Fine -(cEstr.Inizio - 1)
        ReDim aColori(0)
        Call GetColoriRiga(aColori,nPosSpia + 2,Iif(aValori(12) = nColpi,vbGreen,vbYellow))
        Call AddRigaTabella(aValori,aColori)
        i = i + 1
        Call AvanzamentoElab(1,CollEstrazioni.count,i)
        If ScriptInterrotto Then Exit For
    Next
    Call Messaggio("Creazione tabella in corso ...")
    Call CreaTabella()
End Sub
Sub CreaTabRiepilogo(CollAmbi,CollAmbiTot,nCasiTrov,nInizio,nFine,nRuota,nRigheMax)
    Dim cAmboF,cAmboP
    Dim i
    
    Call Messaggio("Tabella riepilogo")

    ' tabella presenze
    Call Scrivi("La seguente tabella indica la frequenza degli ambi e le rispettive presenze")
    Call Scrivi
    ReDim aTitoli(8)
    aTitoli(1) = "Ambo"
    aTitoli(2) = "Presenze"
    aTitoli(3) = "Percentuale"
    aTitoli(4) = "Frequenza"
    aTitoli(5) = "Freq/Pres"
    aTitoli(6) = "Ritardo"
    aTitoli(7) = "RitMax"
    aTitoli(8) = "Ultima"
    
    Call InitTabella(aTitoli,vbBlue,,,vbWhite)
    
    ReDim aColori(8)
    aColori(1) = vbCyan
    aColori(2) = vbGreen
    aColori(3) = vbYellow
    aColori(4) = vbGreen
    aColori(5) = RGB(255,100,100)
    aColori(6) = RGB(255,90,90)
    aColori(7) = RGB(255,80,80)
    aColori(8) = RGB(255,70,70)
    
    
    For Each cAmboF In CollAmbi
        Set cAmboP = CollAmbiTot(cAmboF.key)
        Call cAmboF.StatisticaAmbo(nInizio,nFine,nRuota)
        ReDim aValori(8)
        aValori(1) = cAmboF.NumeriString
        aValori(2) = cAmboP.presenze
        aValori(3) = Round(Dividi((cAmboP.presenze * 100),nCasiTrov),3) & " %"
        aValori(4) = cAmboF.presenze
        aValori(5) = Round(Dividi(cAmboF.presenze,cAmboP.presenze),3)
        aValori(6) = cAmboF.Ritardo
        aValori(7) = cAmboF.RitardoMax
        aValori(8) = nFine - cAmboF.ritardo
        
        
        Call AddRigaTabella(aValori,aColori)
        i = i + 1
        Call AvanzamentoElab(1,nRigheMax,i)
        If ScriptInterrotto Then Exit For
        If i = nRigheMax Then Exit For

    Next
    Call Messaggio("Creazione tabella in corso ...")
    Call CreaTabella(2,- 1,,nRigheMax,0)
End Sub

Mi raccomando a non esagerare con le vincite. La Lottomatica è in agguato.

 

[LOTTOLEON]

bene grazie claudio8 ottimo script
anche al sig luigib
effetivamente e' molto valido

comunque se riesci a modificare l'altro come detto perche voglio fare la ricerca su tutte

ciao