Novità

Per Luigi

solare

solare

Advanced Member >PLATINUM<
Ciao Luigi, ti chiedo se possibile, una modifica a questo favoloso tuo listato. Modificare l'inserimento del numero fisso. adesso da solo la possibilità di inserire un solo nr. fisso. Non è possibile inserire la tabella numerica in modo da poter inserire più numeri fissi ?

Option Explicit
Class ClsCombinazione
Private aNumeri
Private aRuote
Private m_ritardo
Private m_frequenza
Private m_ritardoMax
Private m_sorte
Private m_EstrIni
Private m_EstrFin
Public Property Get Ruote
Ruote = aRuote
End Property
Public Property Get Sorte
Sorte = m_sorte
End Property
Public Property Get EstrIni
EstrIni = m_EstrIni
End Property
Public Property Get EstrFin
EstrFin = m_EstrFin
End Property
Public Property Get Ritardo
Ritardo = m_ritardo
End Property
Public Property Get Frequenza
Frequenza = m_frequenza
End Property
Public Property Get RitardoMax
RitardoMax = m_ritardoMax
End Property
Sub EseguiStat(vNumeri,vRuote,Sorte,Inizio,Fine)
Dim nColTot,r
ReDim aR(1)
aNumeri = vNumeri
aRuote = vRuote
m_sorte = Sorte
m_EstrIni = Inizio
m_EstrFin = Fine
m_ritardo = 0
m_frequenza = 0
m_ritardoMax = 0
Call StatisticaFormazioneTurbo(aNumeri,aRuote,m_sorte,m _ritardo,m_ritardoMax,0,m_frequenza,m_EstrIni,m_Es trFin)
End Sub
Function StringaNum
StringaNum = StringaNumeri(aNumeri)
End Function
End Class
Sub Main
Dim nQNum,nSorte,Inizio,Fine,nFisso,idMese,nEstrAna
Dim Coll,clsCmb
Dim R,j
Dim idTipoRic
ReDim aNumeri(0)
ReDim aVTable(11)
ReDim abMesi(12)
Dim aVTipoRic
aVTipoRic = Array("Frequenza","Ritardo","RitardoMax")
idMese = ScegliMese
abMesi(idMese) = True
nFisso = Sceglifisso
aVTable(1) = "Ruota"
ResetTimer

For R = 2 To 11
aVTable(R) = "A" & R - 1
Next
Call InitTabella(aVTable)
Inizio = 9000'EstrazioneIni
Fine = EstrazioneFin
nQNum = ScegliNumeri(aNumeri)
nSorte = ScegliEsito(2)
idTipoRic = ScegliTipoRicerca
nEstrAna = AttivaEstrazioni(Inizio,Fine,abMesi)
For R = 1 To 12
'If R <> 11 Then
aVTable(1) = NomeRuota(R)
Call Messaggio(aVTable(1))
Set Coll = GetNewCollection
Call EseguiStatistica(nFisso,aNumeri,R,nSorte,nSorte,In izio,Fine,Coll)
Call OrdinaItemCollection(Coll,aVTipoRic(idTipoRic))
'For j = 2 To 11
For j = 2 To Coll.count + 1
If j > 11 Then Exit For
Set clsCmb = Coll(j - 1)
If aVTipoRic(idTipoRic) = "Frequenza" Then
aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.Frequenza & "</font>)"
ElseIf aVTipoRic(idTipoRic) = "Ritardo" Then
aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.Ritardo & "</font>)"
ElseIf aVTipoRic(idTipoRic) = "RitardoMax" Then
aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.RitardoMax & "</font>)"
End If
Next
Call AddRigaTabella(aVTable)
'End If
Call AvanzamentoElab(1,12,R)
Next
SetTableWidth("100%")
Call Scrivi("Range analizzato : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
Call Scrivi("Numero fisso ; " & Iif(nFisso = 0,"Nessuno",nFisso))
Call Scrivi("Mese analizzato : " & Iif(idMese = 0,"Tutti",MeseNome(idMese)))
Call Scrivi("Estrazioni tot, : " & nEstrAna)
Call Scrivi(String(100,"-"))
Call CreaTabella
Scrivi "Tempo di Elaborazione : " & TempoTrascorso,1

End Sub
Sub EseguiStatistica(nFisso,vNumeri,nRuota,Classe,Sort e,Inizio,Fine,CollDest)
Dim nColTot
Dim cComb
ReDim aFissi(1)
aFissi(1) = nFisso
ReDim aR(1)
aR(1) = nRuota
If aFissi(1) > 0 Then
nColTot = InitSviluppoIntegrale(vNumeri,Classe,aFissi)
Else
nColTot = InitSviluppoIntegrale(vNumeri,Classe)
End If
ReDim aCol(0)
Do While GetCombSviluppo(aCol)
Set cComb = New ClsCombinazione
Call cComb.EseguiStat(aCol,aR,Sorte,Inizio,Fine)
CollDest.Add cComb
Loop
End Sub
Private Function MeseValido(idEstr,aMesi)
If aMesi(0) Then
MeseValido = True
Else
MeseValido = aMesi(Mese(idEstr))
End If
End Function
Private Function AttivaEstrazioni(Inizio,fine,aMesi)
Dim k
Dim nValide,b
nValide = 0
For k = Inizio To fine
b = MeseValido(k,aMesi)
Call ImpostaEstrazione(k,CBool(b))
If b Then
nValide = nValide + 1
End If
Next
AttivaEstrazioni = nValide
End Function
Function ScegliMese
Dim aV
aV = Array("Tutti","Gen","Feb","Mar","Apr","Mag","Giu", "Lug","Ago","Set","Ott","Nov","Dic")
ScegliMese = ScegliOpzioneMenu(aV,0)
End Function
Function Sceglifisso
ReDim aV(90)
Dim k
aV(0) = "Nessun fisso"
For k = 1 To 90
aV(k) = k
Next
Sceglifisso = ScegliOpzioneMenu(aV,0)
End Function
Function ScegliTipoRicerca
Dim aV
aV = Array("Frequenza","Ritardo","RitardoMax")
ScegliTipoRicerca = ScegliOpzioneMenu(aV,0)
End Function
 
Ultima modifica:
L

LuigiB

Guest
ciao ecco la modifica

Codice: 
Option Explicit
Class ClsCombinazione
    Private aNumeri
    Private aRuote
    Private m_ritardo
    Private m_frequenza
    Private m_ritardoMax
    Private m_sorte
    Private m_EstrIni
    Private m_EstrFin
    Public Property Get Ruote
        Ruote = aRuote
    End Property
    Public Property Get Sorte
        Sorte = m_sorte
    End Property
    Public Property Get EstrIni
        EstrIni = m_EstrIni
    End Property
    Public Property Get EstrFin
        EstrFin = m_EstrFin
    End Property
    Public Property Get Ritardo
        Ritardo = m_ritardo
    End Property
    Public Property Get Frequenza
        Frequenza = m_frequenza
    End Property
    Public Property Get RitardoMax
        RitardoMax = m_ritardoMax
    End Property
    Sub EseguiStat(vNumeri,vRuote,Sorte,Inizio,Fine)
        Dim nColTot,r
        ReDim aR(1)
        aNumeri = vNumeri
        aRuote = vRuote
        m_sorte = Sorte
        m_EstrIni = Inizio
        m_EstrFin = Fine
        m_ritardo = 0
        m_frequenza = 0
        m_ritardoMax = 0
        Call StatisticaFormazioneTurbo(aNumeri,aRuote,m_sorte,m_ritardo,m_ritardoMax,0,m_frequenza,m_EstrIni,m_EstrFin)
    End Sub
    Function StringaNum
        StringaNum = StringaNumeri(aNumeri)
    End Function
End Class
Sub Main
    Dim nQNum,nQFissi,nSorte,Inizio,Fine,nFisso,idMese,nEstrAna
    Dim Coll,clsCmb
    Dim R,j
    Dim idTipoRic
    ReDim aNumeri(0)
    ReDim aFissi (0)
    ReDim aVTable(11)
    ReDim abMesi(12)

    Dim aVTipoRic
    Dim nClasse

    nClasse = Int(InputBox ("Sviluppa lunghette classe", , "5") )
    nQFissi =0
    aVTipoRic = Array("Frequenza","Ritardo","RitardoMax")
    idMese = ScegliMese
    abMesi(idMese) = True
    'nFisso = Sceglifisso
    aVTable(1) = "Ruota    "
    ResetTimer
    For R = 2 To 11
        aVTable(R) = "A" & R - 1 & Space(15)
    Next
    Call InitTabella(aVTable )
    Inizio = 9000'EstrazioneIni
    Fine = EstrazioneFin

    nQNum = ScegliNumeri(aNumeri)
    If MsgBox ("Scegliere dei numeri fissi ?" , vbQuestion + vbYesNo) = vbYes Then   
        nQFissi =  ScegliNumeri(aFissi  )
    End If

    If NumeriRipetutiTraVett(  aNumeri , aFissi) Then
        MsgBox "Numeri ripetuti tra fissi e variabili"
        Exit Sub
    End If
    nSorte = ScegliEsito(2)
    idTipoRic = ScegliTipoRicerca
    nEstrAna = AttivaEstrazioni(Inizio,Fine,abMesi)
    For R = 1 To 12
        'If R <> 11 Then
        aVTable(1) = NomeRuota(R)
        Call Messaggio(aVTable(1))
        Set Coll = GetNewCollection
        Call EseguiStatistica(aFissi,aNumeri,R, nClasse ,nSorte,Inizio,Fine,Coll)
        Call OrdinaItemCollection(Coll,aVTipoRic(idTipoRic))
        'For j = 2 To 11
        For j = 2 To Coll.count + 1
            If j > 11 Then Exit For
            Set clsCmb = Coll(j - 1)
            If aVTipoRic(idTipoRic) = "Frequenza" Then
                aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.Frequenza & "</font>)"
            ElseIf aVTipoRic(idTipoRic) = "Ritardo" Then
                aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.Ritardo & "</font>)"
            ElseIf aVTipoRic(idTipoRic) = "RitardoMax" Then
                aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.RitardoMax & "</font>)"
            End If
        Next
        Call AddRigaTabella(aVTable )
        'End If

    Next
    SetTableWidth("100%")
    Call Scrivi("Range analizzato : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
    Call Scrivi("Numero fissi : " & Iif( nQFissi = 0 ,"Nessuno",StringaNumeri (aFissi )))
    Call Scrivi("Mese analizzato : " & Iif(idMese = 0,"Tutti",MeseNome(idMese)))
    Call Scrivi("Estrazioni tot, : " & nEstrAna)
    Call Scrivi(String(100,"-"))
    Call CreaTabella
    Scrivi "Tempo di Elaborazione : " & TempoTrascorso,1
End Sub
Sub EseguiStatistica(aFissi,vNumeri,nRuota,Classe,Sorte,Inizio,Fine,CollDest)
    Dim nColTot , nFatte
    Dim cComb
    ReDim aR(1)
    aR(1) = nRuota
    If aFissi(1) > 0 Then
        nColTot = InitSviluppoIntegrale(vNumeri,Classe,aFissi)
    Else
        nColTot = InitSviluppoIntegrale(vNumeri,Classe)
    End If
    ReDim aCol(0)
    nFatte =0
    Do While GetCombSviluppo(aCol)
        Set cComb = New ClsCombinazione
        Call cComb.EseguiStat(aCol,aR,Sorte,Inizio,Fine)
        CollDest.Add cComb
        nFatte = nFatte +1

        Call AvanzamentoElab (1,nColTot , nFatte  )

        If ScriptInterrotto Then Exit Do

    Loop
End Sub
Private Function MeseValido(idEstr,aMesi)
If aMesi(0) Then
    MeseValido = True
Else
    MeseValido = aMesi(Mese(idEstr))
End If
End Function
Private Function AttivaEstrazioni(Inizio,fine,aMesi)
Dim k
Dim nValide,b
nValide = 0
For k = Inizio To fine
    b = MeseValido(k,aMesi)
    Call ImpostaEstrazione(k,CBool(b))
    If b Then
        nValide = nValide + 1
    End If
Next
AttivaEstrazioni = nValide
End Function
Function ScegliMese
    Dim aV
    aV = Array("Tutti","Gen","Feb","Mar","Apr","Mag","Giu", "Lug","Ago","Set","Ott","Nov","Dic")
    ScegliMese = ScegliOpzioneMenu(aV,0)
End Function
Function Sceglifisso
    ReDim aV(90)
    Dim k
    aV(0) = "Nessun fisso"
    For k = 1 To 90
        aV(k) = k
    Next
    Sceglifisso = ScegliOpzioneMenu(aV,0)
End Function
Function ScegliTipoRicerca
    Dim aV
    aV = Array("Frequenza","Ritardo","RitardoMax")
    ScegliTipoRicerca = ScegliOpzioneMenu(aV,0)
End Function
Function  NumeriRipetutiTraVett (aNumeri , aFissi)
    Dim ab , k , nRip  
    nRip =0
    ab=  ArrayNumeriToBool (aFissi )

    For k = 1 To UBound(aNumeri)
        If ab( aNumeri(k)) Then
            nRip = nRip +1
        End If
    Next
    NumeriRipetutiTraVett = nRip

End Function
 
fillotto

fillotto

Advanced Member >PLATINUM<
LuigiB;n2102176 ha scritto:
ciao ecco la modifica

Codice: 
Option Explicit
Class ClsCombinazione
Private aNumeri
Private aRuote
Private m_ritardo
Private m_frequenza
Private m_ritardoMax
Private m_sorte
Private m_EstrIni
Private m_EstrFin
Public Property Get Ruote
Ruote = aRuote
End Property
Public Property Get Sorte
Sorte = m_sorte
End Property
Public Property Get EstrIni
EstrIni = m_EstrIni
End Property
Public Property Get EstrFin
EstrFin = m_EstrFin
End Property
Public Property Get Ritardo
Ritardo = m_ritardo
End Property
Public Property Get Frequenza
Frequenza = m_frequenza
End Property
Public Property Get RitardoMax
RitardoMax = m_ritardoMax
End Property
Sub EseguiStat(vNumeri,vRuote,Sorte,Inizio,Fine)
Dim nColTot,r
ReDim aR(1)
aNumeri = vNumeri
aRuote = vRuote
m_sorte = Sorte
m_EstrIni = Inizio
m_EstrFin = Fine
m_ritardo = 0
m_frequenza = 0
m_ritardoMax = 0
Call StatisticaFormazioneTurbo(aNumeri,aRuote,m_sorte,m_ritardo,m_ritardoMax,0,m_frequenza,m_EstrIni,m_EstrFin)
End Sub
Function StringaNum
StringaNum = StringaNumeri(aNumeri)
End Function
End Class
Sub Main
Dim nQNum,nQFissi,nSorte,Inizio,Fine,nFisso,idMese,nEstrAna
Dim Coll,clsCmb
Dim R,j
Dim idTipoRic
ReDim aNumeri(0)
ReDim aFissi (0)
ReDim aVTable(11)
ReDim abMesi(12)

Dim aVTipoRic
Dim nClasse

nClasse = Int(InputBox ("Sviluppa lunghette classe", , "5") )
nQFissi =0
aVTipoRic = Array("Frequenza","Ritardo","RitardoMax")
idMese = ScegliMese
abMesi(idMese) = True
'nFisso = Sceglifisso
aVTable(1) = "Ruota "
ResetTimer
For R = 2 To 11
aVTable(R) = "A" & R - 1 & Space(15)
Next
Call InitTabella(aVTable )
Inizio = 9000'EstrazioneIni
Fine = EstrazioneFin

nQNum = ScegliNumeri(aNumeri)
If MsgBox ("Scegliere dei numeri fissi ?" , vbQuestion + vbYesNo) = vbYes Then
nQFissi = ScegliNumeri(aFissi )
End If

If NumeriRipetutiTraVett( aNumeri , aFissi) Then
MsgBox "Numeri ripetuti tra fissi e variabili"
Exit Sub
End If
nSorte = ScegliEsito(2)
idTipoRic = ScegliTipoRicerca
nEstrAna = AttivaEstrazioni(Inizio,Fine,abMesi)
For R = 1 To 12
'If R <> 11 Then
aVTable(1) = NomeRuota(R)
Call Messaggio(aVTable(1))
Set Coll = GetNewCollection
Call EseguiStatistica(aFissi,aNumeri,R, nClasse ,nSorte,Inizio,Fine,Coll)
Call OrdinaItemCollection(Coll,aVTipoRic(idTipoRic))
'For j = 2 To 11
For j = 2 To Coll.count + 1
If j > 11 Then Exit For
Set clsCmb = Coll(j - 1)
If aVTipoRic(idTipoRic) = "Frequenza" Then
aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.Frequenza & "</font>)"
ElseIf aVTipoRic(idTipoRic) = "Ritardo" Then
aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.Ritardo & "</font>)"
ElseIf aVTipoRic(idTipoRic) = "RitardoMax" Then
aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.RitardoMax & "</font>)"
End If
Next
Call AddRigaTabella(aVTable )
'End If

Next
SetTableWidth("100%")
Call Scrivi("Range analizzato : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
Call Scrivi("Numero fissi : " & Iif( nQFissi = 0 ,"Nessuno",StringaNumeri (aFissi )))
Call Scrivi("Mese analizzato : " & Iif(idMese = 0,"Tutti",MeseNome(idMese)))
Call Scrivi("Estrazioni tot, : " & nEstrAna)
Call Scrivi(String(100,"-"))
Call CreaTabella
Scrivi "Tempo di Elaborazione : " & TempoTrascorso,1
End Sub
Sub EseguiStatistica(aFissi,vNumeri,nRuota,Classe,Sorte,Inizio,Fine,CollDest)
Dim nColTot , nFatte
Dim cComb
ReDim aR(1)
aR(1) = nRuota
If aFissi(1) > 0 Then
nColTot = InitSviluppoIntegrale(vNumeri,Classe,aFissi)
Else
nColTot = InitSviluppoIntegrale(vNumeri,Classe)
End If
ReDim aCol(0)
nFatte =0
Do While GetCombSviluppo(aCol)
Set cComb = New ClsCombinazione
Call cComb.EseguiStat(aCol,aR,Sorte,Inizio,Fine)
CollDest.Add cComb
nFatte = nFatte +1

Call AvanzamentoElab (1,nColTot , nFatte )

If ScriptInterrotto Then Exit Do

Loop
End Sub
Private Function MeseValido(idEstr,aMesi)
If aMesi(0) Then
MeseValido = True
Else
MeseValido = aMesi(Mese(idEstr))
End If
End Function
Private Function AttivaEstrazioni(Inizio,fine,aMesi)
Dim k
Dim nValide,b
nValide = 0
For k = Inizio To fine
b = MeseValido(k,aMesi)
Call ImpostaEstrazione(k,CBool(b))
If b Then
nValide = nValide + 1
End If
Next
AttivaEstrazioni = nValide
End Function
Function ScegliMese
Dim aV
aV = Array("Tutti","Gen","Feb","Mar","Apr","Mag","Giu", "Lug","Ago","Set","Ott","Nov","Dic")
ScegliMese = ScegliOpzioneMenu(aV,0)
End Function
Function Sceglifisso
ReDim aV(90)
Dim k
aV(0) = "Nessun fisso"
For k = 1 To 90
aV(k) = k
Next
Sceglifisso = ScegliOpzioneMenu(aV,0)
End Function
Function ScegliTipoRicerca
Dim aV
aV = Array("Frequenza","Ritardo","RitardoMax")
ScegliTipoRicerca = ScegliOpzioneMenu(aV,0)
End Function
Function NumeriRipetutiTraVett (aNumeri , aFissi)
Dim ab , k , nRip
nRip =0
ab= ArrayNumeriToBool (aFissi )
sca
For k = 1 To UBound(aNumeri)
If ab( aNumeri(k)) Then
nRip = nRip +1
End If
Next
NumeriRipetutiTraVett = nRip

End Function
Clicca per espandere...

Minghia che roba!!!! velocità pazzesca in relazionealla moledei dati:eek::eek:
 
solare

solare

Advanced Member >PLATINUM<
Hai ragione filotto......mi chiedo ma Luigi è umano ? scherzo ovviamente........secondo me una dote pazzesca nella programmazione.
Una cosa è certa ci ha regalato una bomba di programma.....se qualcuno non l'avessi capito.......GRATISSSSSSSSSSSSSSSSSS
ai giorni d'oggi chi fa così tanto gratis........
Grazie Luigi
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 04 maggio 2024
    Bari
    02
    31
    81
    52
    21
    Cagliari
    39
    88
    84
    01
    67
    Firenze
    36
    30
    70
    06
    41
    Genova
    59
    23
    61
    22
    27
    Milano
    05
    17
    69
    57
    39
    Napoli
    81
    62
    82
    43
    50
    Palermo
    73
    55
    62
    45
    18
    Roma
    76
    70
    01
    64
    15
    Torino
    82
    55
    35
    70
    46
    Venezia
    58
    23
    61
    29
    21
    Nazionale
    10
    14
    01
    43
    09
    Estrazione Simbolotto
    Milano
    30
    01
    05
    32
    11
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Alto