Aiuto da Claudio8 e/o Magia

fillotto · 2 Marzo 2016

Ho notato questo script fatto dal Maestro Luigi che Claudio8 ha consigliato ad un utente , siccome mi diverto per riconvertire gli script + belli adattandoli alla lotteria Pennsilvania 30 num , quasi semprew ci riesco ma in questo ci sto provando da giorni e di quattro tabelle me ne fa solo una(male) , l'ultima

Codice:

 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

trasformato da me x adattarlo a 30 numeri ma come già detto non ci sono....mi aiutate ?

Codice:

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)
ReDim aRuota(1)
aRuota(1) = nRuota
Call StatisticaFormazioneFT(aNumeri,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 'oooooooooooooooooooooooooooooooooooo              MAIN PRINCIPALE                  oooooooooooooooooooooooooooooooooooooo
Dim nSpia
Dim nInizio,nFine,nColpi
Dim idEstr,k,e,i
Dim sfilearchivio,sfile
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",,500))

sfilearchivio = GetDirectoryAppData & "ArchivioPensy\PENSY.txt" 'OOOOOOOOOOOO MIO PERCORSO  OOOOOOOOOOOOOOOOO
Call ApriBaseDatiFT(sfilearchivio,05,",",30)

    nInizio = EstrazioniArchivioFT - nEs
    nFine = EstrazioniArchivioFT - 10
Set CollAmbi = GetNewCollection
Set CollEstrazioni = GetNewCollection
Set CollAmbiTot = GetNewCollection

If isNumeroValidoLotto(nSpia) And nColpi > 0 Then
For idEstr = nInizio To nFine
bTrovato = IsNumeroPresenteInEstrazioneFT(idEstr,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)                       'l'ho dovuta levare
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 IsNumeroPresenteInEstrazioneFT(i,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,nInizio,nFine,RigheMaxRiepilogo)

Call CreaTabPresenze(CollAmbi,RigheMaxTabAmbiFreq)
Call CreaTabCopertura(CollAmbiTot,CollEstrazioni,RigheMaxTabCopertura)
Call CreaTabCasiRilevati(CollEstrazioni,nSpia,nColpi,nInizio,nFine)
End If

End Sub 'oooooooooooooooooooooooooooooooooooo        FINE      MAIN PRINCIPALE                  oooooooooooooooooooooooooooooooooooooo

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(30)
Dim aColonne
Dim cAmbo
For k = 1 To 30
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) 'ooooooooooooooooooo 3^ Tabella mette solo etichette ooooooooooooooooooooooo
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 ' FINE 3^ TABELLA  FINE 3^ TABELLA  FINE 3^ TABELLA


Sub CreaTabPresenze(CollAmbi,nRigheMax) 'INIZIO 2^ TABELLA
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 'FINE  2^ TABELLA
'nInizio = EstrazioneFin - nes
'nFine = EstrazioneFin
'nRuota = ScegliRuota



Sub CreaTabCasiRilevati(CollEstrazioni,nSpia,nColpi,nInizio,nFine) '  Inizio 4^ TABELLA
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 " & " PE " & " dal " & DataEstrazioneFT(nInizio) & " a " & DataEstrazioneFT(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) = DataEstrazioneFT(cEstr.idEst)
nPosSpia = 0
For k = 1 To 5
n = EstrattoFT(cEstr.idEst,k)
aValori(k + 2) = n
If n = nSpia Then
nPosSpia = k
End If
Next
aValori(8) = cEstr.GetAmboPiuFreq(nFreq) ' non mette questo valore
aValori(9) = nFreq ' non mette questo valore
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 'FINE 4^ TABELLA FINE 4^ TABELLA FINE 4^ TABELLA



Sub CreaTabRiepilogo(CollAmbi,CollAmbiTot,nCasiTrov,nInizio,nFine,nRigheMax) '1^ TABELLA INIZIO '1^ TABELLA INIZIO '1^ TABELLA INIZIO
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)
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 'FINE 1^ TABELLA FINE 1^ TABELLA FINE 1^ TABELLA

fillotto · 2 Marzo 2016

Forse ho capito da che cosa possa dipendere il cattivo funzionamento ,naturalmente ho dovuto togliere tutti gli argomenti (riguardanti la ruota) nelle varie funzioni però questa istruzione che ho dovuto remmare perchè non ha corrispettivo FT
ho REmmato questa istruzione " Call GetArrayNumeriRuota(i,nRuota,aNum) " come potrei aggirare l'ostacolo?

fillotto · 3 Marzo 2016

Claudio vedi l'output che ottengo, mi fa solo parte della 4^ tabella puoi vedere perchè ?

claudio8 · 3 Marzo 2016

fillotto;n1962050 ha scritto:
Claudio vedi l'output che ottengo, mi fa solo parte della 4^ tabella puoi vedere perchè ?

Ho dato una prima occhiata ieri sera, ma non ho potuto risolvere, era notte inoltrata e la palpebra era cadente.... se riesco provo a riprenderlo appena posso. Non correre che la fretta fai figli cechi.
ciao

fillotto · 5 Marzo 2016

Grazie Magia (e Amaretto (?!)) funziona

adesso mi vedo con calma le soluzioni, grazie comunque anche a Claudio8

Cerca

Cerca

Aiuto da Claudio8 e/o Magia

fillotto

Advanced Member >PLATINUM<

fillotto

Advanced Member >PLATINUM<

fillotto

Advanced Member >PLATINUM<

claudio8

Premium Member

fillotto

Advanced Member >PLATINUM<

Ultima estrazione Lotto

Ultimi Messaggi