Funzione incRitMax

LuigiB · 23 Gennaio 2015

ben , sei riuscito a tradurre , ti posto lo script come lo avevo fatto io e un 0immagine che evidenzia i tuoi errori.
E' meglio usare una funzione come quella fatta da me che ti fa ritornare l'array con i valori, è il modo piu flessibile
poi il chiamante con quell'array fa quello che vuole , come costruire la stringa da 1 a ubound(aRetDiff) oppure uscendo dal ciclo se l'iteratore ha superato il numero voluto

Codice:

Option Explicit
Sub Main
	
	
	Dim aRit,aEstr,aRetDiff
	Dim idMax
	ReDim aNum(1)
	ReDim aRuo(1)
	Dim k
	aNum(1) = 55
	aRuo(1) = BA_
	
	Call ElencoRitardi(aNum,aRuo,1,5000,EstrazioniArchivio,aRit,aEstr)
	
	Call GetArrayDiffRitMax(aRit,aRetDiff)
	
	
	
	idMax = UBound(aRit) 
	For k = 1 To UBound(aRetDiff)
		Scrivi FormattaStringa(CStr(aRetDiff(k)),"000") & " -- (" & aRit(idMax) & " - " & aRit(idMax - 1) & ")"
		idMax = idMax - 1
	Next
End Sub
Function GetArrayDiffRitMax(aRitardi,aRetDiff)
	Dim idMax,idTmp
	Dim nQDiff
	
	Call OrdinaMatrice(aRitardi,1)
	
	nQDiff = 0
	ReDim aRetDiff(nQDiff)
	idMax = UBound(aRitardi) 
	Do While idMax > 0
		idTmp = idMax - 1
		If idTmp > 0 Then
			nQDiff = nQDiff + 1
			ReDim Preserve aRetDiff(nQDiff)
			aRetDiff(nQDiff) = aRitardi(idMax) - aRitardi(idTmp)
		Else
			Exit Do
		End If
		idMax = idMax - 1
	Loop
End Function

free image upload

i legend · 23 Gennaio 2015

Ciao Luigi sto studiando il tuo codice,
Ti faccio alcune domande:
1) La tua funzione perchè non restituisce un valore?Mi spiego meglio , quando la richiamo nella sub main devo dichiarare l'IdMax,e,se scrivo un valore diverso mi restituisce errore,es ho sostituito Ubound(aRit) con 5.
2) se eseguo il ciclo for nella sub è più veloce che nella function?
Ho provato ad inserire il codice ma mi restituisce errore,
Sto cercando di utilizzarla nello script che mi avevi corretto

Codice:

Call ElencoRitardiTurbo(aNumeri,aRu,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr)
        Call GetArrayDiffRitMax(aRetRitardi,aRetDiff)
        IdMax = 5
        For k = 1 To IdMax
            prova = aRetDiff(k) & "." & prova
            IdMax = IdMax - 1
        Next
        prova = RimuoviLastChr(prova,".")

Grazie per la tua disponibilità, cerco di capire perchè non riesco a farlo funzionre.
A dopo

i legend · 23 Gennaio 2015

Ancora una domanda:
Ho capito l'if superfluo
ma le altre due indicazioni no, ne il riferimento all'array , e perchè qIncr scritto li non ha valore.
In effetti la logica degli if è semplice ma faccio presto a sbagliare

Grazie infinite per la tua pazienza prof

LuigiB · 23 Gennaio 2015

se lo script che ho postato ti funziona è quello che devi studiare per capire dove sbagli.
io ho provato sia con ElencoRitardi che von ElencoRitardiTurbo
semmai posta un esempio da poter eseguire cois lo provo

i legend · 23 Gennaio 2015

Ok studio tutto,se ci riesco posto lo script completo e funzionante, se non ci riesco posto lo script incasinato

a dopo

i legend · 23 Gennaio 2015

Ciao Luigi forse ho capito dove sbaglio faccio delle prove e spedisco lo script

Grazieeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee

i legend · 23 Gennaio 2015

Niente non riesco
Ti posto lo script che mi avevi corretto,
Ho fatto delle modifiche perchè ho inserito la nuova tabellaOrdinabile
Grazie

Codice:

Option Explicit
Sub Main
    Dim Ini,Fin,nEstr,es,k,x,r,nValore,idOrd,TipOrd,Ctr,z,aIncr,qRit,aRetDiff,IdMax,prova
    Dim DevStd,disCeb,ScaCeb,qIncr
    Dim nColTotSvil
    Dim s,e,ritardo,ritardomax,IncrRitMax,RitMed,RitMese,ScartoRit,aRit
    Dim Frequenza,freqTeorica,FreqMese,freq,FreqTot,Scarto
    Dim nNumeri,aColonne
    ReDim aNumeri(0)
    Dim aRu(1)
    Dim nCombinazione,nSorte,nCiclo
    Dim aTitolo
    ReDim aRetRitardi(0)
    ReDim aRetIdEstr(0)
    Fin = EstrazioneFin
    qIncr = 5
    qRit = 5
    IdMax = UBound(aRetRitardi) - 1
    If ImpostaParametri(nNumeri,nCombinazione,nSorte,Ctr,aRu,r,Ini) = False Then
        'If ImpostaParametri(nNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,aRu,r,Ini) = False Then
        MsgBox "Parametri non corretti",vbCritical
        Exit Sub
    End If
    'Imposto i titoli delle colonne della tabella statistica
    aTitolo = Array("","ID","Comb","freq","Scarto","Rit","RitMed","aRit","RitSto","IncR.s","aIncr","ScartoRit","DevStd","disCeb","ScaCeb99%","GEN","FEB","MAR","APR","MAG","GIU","LUG","AGO","Set","OTT","NOV","DIC")
    InitTabella aTitolo,RGB(221,221,221),,3,vbBlack
    'conto le estrazioni utili
    nEstr = ContaEstrazioni(Ini,Fin,r)
    nValore = Round(CicloTeorico(nCombinazione,nSorte,CInt(Ctr)),2)
    freqTeorica = Round(Dividi(nEstr,nValore),2)
    
    ReDim aColSviluppo(0)
    nColTotSvil = Combinazioni(UBound(nNumeri),nCombinazione)
    ReDim nMese(nColTotSvil,12)
    For z = 1 To 12
        Call ImpostaEstrazioniAttivePerMese(z,Ini,Fin)
        nColTotSvil = InitSviluppoIntegrale(nNumeri,nCombinazione)
        k = 0
        Do While GetCombSviluppo(aColSviluppo)
            k = k + 1
            nMese(k,z) = TrovaFrequenzaMese(aColSviluppo,aRu,nSorte,Ini,Fin,z)
        Loop
    Next
    Call ResetEstrazioniAttive(z,Ini,Fin)
    k = 0
    nColTotSvil = InitSviluppoIntegrale(nNumeri,nCombinazione)
    Do While GetCombSviluppo(aNumeri)
        k = k + 1
        
        Messaggio "Elaborazione in corso id sviluppo: " & k
        AvanzamentoElab 1,nColTotSvil,k
        If ScriptInterrotto Then Exit Do
        s = StringaNumeri(aNumeri,,True)
        Call StatisticaFormazioneTurbo(aNumeri,aRu,nSorte,ritardo,ritardomax,IncrRitMax,Frequenza,Ini,Fin)
        FreqTot = Frequenza
        
        RitMese = TrovaRitardoMese(aNumeri,aRu,nSorte,Ini,Fin,"TUTTI")
        Scarto = Round(FreqTot - freqTeorica,2)
        ScartoRit = Round(ritardomax - ritardo,2)
        ' richiamo la funzione elenca ritardi, per poter attingere alla marice che elenca i ritardi  voce:( aRetRitardi)
        Call ElencoRitardiTurbo(aNumeri,aRu,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr)
        '
        '
        '
        Call GetArrayDiffRitMax(aRetRitardi,aRetDiff)
        For k = 1 To qIncr
            prova = aRetDiff(k) & "." & prova
            IdMax = IdMax - 1
        Next
        prova = RimuoviLastChr(prova,".")
        '
        '
        '
        ' scritta funzione per calcolare il ritardo medio della formazione
        RitMed = RitardoMedio(aRetRitardi)
        aRit = UltimiRitardi(qRit,aRetRitardi)
        '
        '
        '
        aIncr = prova 'Questa è il problema
        ' scritta funzione per calcolo deviazione standard della funzione
        '
        '
        DevStd = CalcolaDeviazioneStd(aRetRitardi)
        disCeb = Round(RitMed +(10*DevStd),2)
        ScaCeb = Round(disCeb - RitMese,2)
        s = RimuoviLastChr(s,".")
        ReDim aRisultato(26)
        'Call AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,RitMed,aRit,ritardomax,IncrRitMax,aIncr,ScartoRit,DevStd,disCeb,ScaCeb,nMese(k,1),nMese(k,2),nMese(k,3),nMese(k,4),nMese(k,5),nMese(k,6),nMese(k,7),nMese(k,8),nMese(k,9),nMese(k,10),nMese(k,11),nMese(k,12))
        Call AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,RitMed,aRit,ritardomax,IncrRitMax,aIncr,ScartoRit,DevStd,disCeb,ScaCeb,nMese(k,1),nMese(k,2),nMese(k,3),nMese(k,4),nMese(k,5),nMese(k,6),nMese(k,7),nMese(k,8),nMese(k,9),nMese(k,10),nMese(k,11),nMese(k,12))
        Call AddRigaTabella(aRisultato,,,3,RGB(0,0,0))',"Consolas")
        Call SetColoreCella(Mese(EstrazioneFin) + 13,RGB(215,215,255),2)
    Loop
    Scrivi FormatSpace("script By I Legend per lottoCed's amici",150,- 1)
    Scrivi
    Scrivi "Tabella Statistica per formazioni libere" & " ",1,,RGB(252,227,143),,5
    Scrivi
    Scrivi "Range Ricerca Estrazioni dal :{" & DataEstrazione(Ini) & " } al : {" & DataEstrazione(Fin) & "}",1,,,,3
    Scrivi "Estrazioni Totali Analizzati :{" & nEstr & "}",1,,,,3
    Scrivi "Numeri di ricerca            :{" & StringaNumeri(nNumeri) & "}",1,,,,3
    Scrivi "Sviluppo numeri in           :{" & k & " " & NomeCombinazione(nCombinazione) & "}",1,,,,3
    Scrivi "Analesi combinazione per     :{" & NomeSorte(nSorte) & "}",1,,,,3
    Scrivi "Ciclo Teorico                :{" & nValore & "}",1,,,,3
    Scrivi "Frequenza Teorica            :{" & freqTeorica & "}",1,,,,3
    Scrivi "Ruota di ricerca             :{" & NomeRuota(aRu(1)) & "}",1,,,,3
    Scrivi "ListaRitari                  :" & ArrayRitardi(aRetRitardi)'IncMax(aRetRitardi)'TipOrd & "}",1,,,,3
    Scrivi
    Call SetTableWidth("100%")
    Call CreaTabellaOrdinabile
End Sub
' riporto qui di seguito tutte le funzioni utilizzate
' per la sub main
' ovviamente possono essere ottimizzate
Sub AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,RitMed,aRit,ritardomax,IncrRitMax,aIncr,ScartoRit,DevStd,disCeb,ScaCeb,Gen,Feb,Mar,Apr,Mag,Giu,Lug,Ago,Stt,Ott,Nov,Dic)
    aRisultato(1) = k ' 
    aRisultato(2) = s ' 
    aRisultato(3) = FreqTot'
    aRisultato(4) = Scarto ' 
    aRisultato(5) = RitMese ' 
    aRisultato(6) = RitMed ' 
    aRisultato(7) = aRit
    aRisultato(8) = ritardomax ' 
    aRisultato(9) = IncrRitMax ' 
    aRisultato(10) = aIncr ' incremento degli ultimi ritardi
    aRisultato(11) = ScartoRit
    aRisultato(12) = DevStd ' 
    aRisultato(13) = disCeb '
    aRisultato(14) = ScaCeb ' 
    aRisultato(15) = Gen 
    aRisultato(16) = Feb'Gennaio ' frequenza per mese
    aRisultato(17) = Mar 'Gennaio ' frequenza per mese
    aRisultato(18) = Apr 'Gennaio ' frequenza per mese
    aRisultato(19) = Mag 'Gennaio ' frequenza per mese
    aRisultato(20) = Giu 'Gennaio ' frequenza per mese
    aRisultato(21) = Lug 'Gennaio ' frequenza per mese
    aRisultato(22) = Ago 'Gennaio ' frequenza per mese
    aRisultato(23) = Stt 'Gennaio ' frequenza per mese
    aRisultato(24) = Ott 'Gennaio ' frequenza per mese
    aRisultato(25) = Nov 'Gennaio ' frequenza per mese
    aRisultato(26) = Dic 'Gennaio ' frequenza per mese
End Sub
Function ImpostaParametri(aNumeri,nCombinazione,nSorte,Ctr,aRu,Ruota,Ini)
    'Function ImpostaParametri(aNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,aRu,Ruota,Ini)
    Dim bRet
    Ini = InizioArchivio(3914)
    If Ini > 0 Then
        Call ScegliNumeri(aNumeri)
        If IsArray(aNumeri) Then
            nCombinazione = ScegliCombinazione
            If nCombinazione > 0 Then
                nSorte = SelEsito
                If nSorte > 0 Then
                    Do While nCombinazione < nSorte
                        MsgBox "hai inserito Un Valore errato riscrivi ": nSorte = CInt(SelEsito)
                        If nSorte = - 1 Then Exit Do
                    Loop
                    If nSorte > 0 Then
                        Ruota = SelRuota ' funziona per selezionare la ruota  statistica su tutte o solo per una ruota
                        If Ruota > 0 Then
                            aRu(1) = Ruota
                            If Ruota = 11 Then
                                Ctr = 10
                            Else
                                Ctr = 1 ' valore utilizzato per calcolo del ciclo teorico
                            End If
                        End If
                        bRet = True
                    End If
                End If
            End If
        End If
    End If
    ImpostaParametri = bRet
End Function
Function TrovaFrequenzaMese(aNumeri,aRu,nSorte,Ini,fin,nMese)
    Dim k
    Dim FreqMese
    FreqMese = SerieFreqTurbo(Ini,fin,aNumeri,aRu,nSorte)
    TrovaFrequenzaMese = FreqMese
End Function
Sub ImpostaEstrazioniAttivePerMese(nMese,Ini,fin)
    Dim k
    If nMese = "TUTTI" Then
        Call ResetEstrazioniAttive(nMese,Ini,fin)
    Else
        For k = Ini To fin
            If Mese(k) = nMese Then
                Call ImpostaEstrazione(k,True)
            Else
                Call ImpostaEstrazione(k,False)
            End If
        Next
    End If
End Sub
Sub ResetEstrazioniAttive(nMese,Ini,fin)
    Dim k
    For k = Ini To fin
        Call ImpostaEstrazione(k,True)
    Next
End Sub
Function TrovaRitardoMese(aNumeri,aRu,nSorte,Ini,fin,nMese)
    Dim k
    Dim RitMese
    If nMese <> "TUTTI" Then
        Call ImpostaEstrazioniAttivePerMese(nMese,Ini,fin)
    End If
    RitMese = SerieRitardoTurbo(Ini,fin,aNumeri,aRu,nSorte)
    TrovaRitardoMese = RitMese
End Function
Function NomeCombinazione(a)
    Dim ris
    Select Case a
    Case 1
        ris = "Estratti"
    Case 2
        ris = "Ambi"
    Case 3
        ris = "Terzine"
    Case 4
        ris = "Quartine"
    Case 5
        ris = "Cinquine"
    End Select
    NomeCombinazione = ris
End Function
Function ScegliCombinazione
    Dim ret
    Dim aVoci
    ' gli array partono sempre da 0
    aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine")
    ret = ScegliOpzioneMenu(aVoci,3," Combina i numeri In :")
    ' serve per gestire il tasto annulla
    ScegliCombinazione = ret
End Function
Function SelEsito
    Dim ret
    Dim aVoci
    ' gli array partono sempre da 0
    aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
    ret = ScegliOpzioneMenu(aVoci,2," Analesi per Sorte di : ")
    SelEsito = ret
End Function
Function SelRuota
    Dim ret
    Dim aVoci
    ' gli Array partono sempre da 0
    aVoci = Array("","BARI","CAGLIARI","FIRENZE","GENOVA","MILANO","NAPOLI","PALERMO","ROMA","TORINO","VENEZIA","TUTTE","NAZIONALE")
    ret = ScegliOpzioneMenu(aVoci,1," Analizza Ruota di : ")
    SelRuota = ret
End Function
Function InizioArchivio(nInizio)
    Dim es
    Dim ret
    ReDim aVoci(EstrazioneFin)
    For es = nInizio To EstrazioneFin
        aVoci(es) = DataEstrazione(es)
    Next
    ret = ScegliOpzioneMenu(aVoci,nInizio,"Inserisci Data Inizio Analisi")
    InizioArchivio = ret
End Function
Function RitardoMedio(aRitardi())
    Dim k
    Dim nElementi
    Dim nMedia
    For k = 1 To UBound(aRitardi) - 1
        nElementi = nElementi + 1
        nMedia = nMedia + aRitardi(k)
    Next
    nMedia = Round(Dividi(nMedia,nElementi),2)
    RitardoMedio = nMedia
End Function
Function CalcolaDeviazioneStd(aRitardi())
    Dim k
    Dim somRit,nMedia,nElementi,nVarianza,nSomSQVar
    For k = 1 To UBound(aRitardi) - 1
        nElementi = nElementi + 1
        somRit = somRit + aRitardi(k)
    Next
    nMedia = Round(Dividi(somRit,nElementi))
    For k = 1 To UBound(aRitardi) - 1
        nSomSQVar = nSomSQVar +((nMedia - aRitardi(k)) ^ 2)
        nVarianza = Round(Dividi(nSomSQVar,nElementi),2)
    Next
    CalcolaDeviazioneStd = Round(Sqr(nVarianza),2)
End Function
Function ContaEstrazioni(Ini,Fin,r)
    Dim Conta,es
    For es = Ini To Fin
        If SommaEstratti(es,r) >= 15 Then Conta = Conta + 1
    Next
    ContaEstrazioni = Conta
End Function
Function UltimiRitardi(qRit,aRetRit())
    Dim n1,r1,conta,x
    For x = 1 To UBound(aRetRit) - 1
        conta = conta + 1
    Next
    If conta = 0 Then
        UltimiRitardi = "N.P"
    ElseIf qRit > conta Then
        qRit = conta
    ElseIf conta > qRit Then
        For n1 = UBound(aRetRit) - 1 To UBound(aRetRit) - qRit Step - 1
            r1 = Format2(aRetRit(n1)) & "." & r1
            r1 = RimuoviLastChr(r1,".")
        Next
        UltimiRitardi = r1
    End If
End Function
Function ArrayRitardi(aRetRit())
    Dim n1,r1
    For n1 = 1 To UBound(aRetRit)
        r1 = Format2(aRetRit(n1)) & "." & r1
        r1 = RimuoviLastChr(r1,".")
    Next
    ArrayRitardi = r1
End Function
Function GetArrayDiffRitMax(aRitardi,aRetDiff)
    Dim idMax,idTmp
    Dim nQDiff
    Call OrdinaMatrice(aRitardi,1)
    nQDiff = 0
    ReDim aRetDiff(nQDiff)
    idMax = UBound(aRitardi)
    Do While idMax > 0
        idTmp = idMax - 1
        If idTmp > 0 Then
            nQDiff = nQDiff + 1
            ReDim Preserve aRetDiff(nQDiff)
            aRetDiff(nQDiff) = aRitardi(idMax) - aRitardi(idTmp)
        Else
            Exit Do
        End If
        idMax = idMax - 1
    Loop
End Function

Ciao e buona notte

LuigiB · 24 Gennaio 2015

ciao Legend , allora dato che lo script è bello lungo mi sono soffermato solo sull'aspetto legato alla nostra funzione GetArrayDiffRitMax

premetto che lanciando lo script a me non da nessun errore , penso che potrebbe capitarti l'errore se il numero di ritardi della combinazione esaminata non consente di produrre un array con i valori delle differenze di almeno di 5 elementi. Forse è questo l'errore che ti capits.

Codice:

		For k = 1 To qIncr
			prova = aRetDiff(k) & "." & prova
			IdMax = IdMax - 1
		Next

infatti la variabile qIncr tu la valorizzi ad inizio script = 5 ... chi te l'ha detto che l'array delle differenze abbia almeno 5 elementi ?
Se vedi la nostra funzione è dinamica.. ti torna il numero di differenze che esistono potrebbero essere 0 come 55 ..
se vuoi leggere gli ultimi 5 devi comunque fare un ciclo da 1 a ubound(aRetDiff) , dentro al ciclo (fai finta che l'iteratore fosse K) verifichi che K sia minore o uguale a qIncr , se non lo è esci con exit for.
In questo modo come vedi tu scorri gli N elementi dell'arrya aRetDiff e ti fermi o quando ne hai raggiunti 5 oppure appena l'arrya non ha piu elementi , per esempio se uBound(aRetDiff) fosse 3 il tuo script darebeb errore m facendo come ti ho detto io invece no.

LuigiB · 24 Gennaio 2015

un altro errore che ho notato è che tu la varianile <prova > che usi per costruire la stringa dei incrRitMAx non la riazzeri mai.
Quindi alla fine ti dventa una stringa piena di numeri dovute alle varie concatenzioni.
Come si risolve questo problema ? Ponendo la stringa = "" prima del ciclo for

i legend · 24 Gennaio 2015

Buona giornata a tutti, ciao Luigi fatta la correzione

.
Il problema rimane se metto pochissime estrazioni. è questo che non capisco perchè?
se non ci sono incrementi dovrebbe lasciare la tabella vuota oppure una stringa"Nessun Incr"..
Non ne vengo a capo, forse non sto considerando qualche parametro.....
Grazie invece per aver scritto la funzione e del tempo che mi/ci dedichi...
Sei grande

P.S:
Non so suonare il violino

lotto_tom75 · 25 Gennaio 2015

i legend ha scritto:

Niente non riesco
Ti posto lo script che mi avevi corretto,
Ho fatto delle modifiche perchè ho inserito la nuova tabellaOrdinabile
Grazie

Codice:

Option Explicit
Sub Main
    Dim Ini,Fin,nEstr,es,k,x,r,nValore,idOrd,TipOrd,Ctr,z,aIncr,qRit,aRetDiff,IdMax,prova
    Dim DevStd,disCeb,ScaCeb,qIncr
    Dim nColTotSvil
    Dim s,e,ritardo,ritardomax,IncrRitMax,RitMed,RitMese,ScartoRit,aRit
    Dim Frequenza,freqTeorica,FreqMese,freq,FreqTot,Scarto
    Dim nNumeri,aColonne
    ReDim aNumeri(0)
    Dim aRu(1)
    Dim nCombinazione,nSorte,nCiclo
    Dim aTitolo
    ReDim aRetRitardi(0)
    ReDim aRetIdEstr(0)
    Fin = EstrazioneFin
    qIncr = 5
    qRit = 5
    IdMax = UBound(aRetRitardi) - 1
    If ImpostaParametri(nNumeri,nCombinazione,nSorte,Ctr,aRu,r,Ini) = False Then
        'If ImpostaParametri(nNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,aRu,r,Ini) = False Then
        MsgBox "Parametri non corretti",vbCritical
        Exit Sub
    End If
    'Imposto i titoli delle colonne della tabella statistica
    aTitolo = Array("","ID","Comb","freq","Scarto","Rit","RitMed","aRit","RitSto","IncR.s","aIncr","ScartoRit","DevStd","disCeb","ScaCeb99%","GEN","FEB","MAR","APR","MAG","GIU","LUG","AGO","Set","OTT","NOV","DIC")
    InitTabella aTitolo,RGB(221,221,221),,3,vbBlack
    'conto le estrazioni utili
    nEstr = ContaEstrazioni(Ini,Fin,r)
    nValore = Round(CicloTeorico(nCombinazione,nSorte,CInt(Ctr)),2)
    freqTeorica = Round(Dividi(nEstr,nValore),2)
    
    ReDim aColSviluppo(0)
    nColTotSvil = Combinazioni(UBound(nNumeri),nCombinazione)
    ReDim nMese(nColTotSvil,12)
    For z = 1 To 12
        Call ImpostaEstrazioniAttivePerMese(z,Ini,Fin)
        nColTotSvil = InitSviluppoIntegrale(nNumeri,nCombinazione)
        k = 0
        Do While GetCombSviluppo(aColSviluppo)
            k = k + 1
            nMese(k,z) = TrovaFrequenzaMese(aColSviluppo,aRu,nSorte,Ini,Fin,z)
        Loop
    Next
    Call ResetEstrazioniAttive(z,Ini,Fin)
    k = 0
    nColTotSvil = InitSviluppoIntegrale(nNumeri,nCombinazione)
    Do While GetCombSviluppo(aNumeri)
        k = k + 1
        
        Messaggio "Elaborazione in corso id sviluppo: " & k
        AvanzamentoElab 1,nColTotSvil,k
        If ScriptInterrotto Then Exit Do
        s = StringaNumeri(aNumeri,,True)
        Call StatisticaFormazioneTurbo(aNumeri,aRu,nSorte,ritardo,ritardomax,IncrRitMax,Frequenza,Ini,Fin)
        FreqTot = Frequenza
        
        RitMese = TrovaRitardoMese(aNumeri,aRu,nSorte,Ini,Fin,"TUTTI")
        Scarto = Round(FreqTot - freqTeorica,2)
        ScartoRit = Round(ritardomax - ritardo,2)
        ' richiamo la funzione elenca ritardi, per poter attingere alla marice che elenca i ritardi  voce:( aRetRitardi)
        Call ElencoRitardiTurbo(aNumeri,aRu,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr)
        '
        '
        '
        Call GetArrayDiffRitMax(aRetRitardi,aRetDiff)
        For k = 1 To qIncr
            prova = aRetDiff(k) & "." & prova
            IdMax = IdMax - 1
        Next
        prova = RimuoviLastChr(prova,".")
        '
        '
        '
        ' scritta funzione per calcolare il ritardo medio della formazione
        RitMed = RitardoMedio(aRetRitardi)
        aRit = UltimiRitardi(qRit,aRetRitardi)
        '
        '
        '
        aIncr = prova 'Questa è il problema
        ' scritta funzione per calcolo deviazione standard della funzione
        '
        '
        DevStd = CalcolaDeviazioneStd(aRetRitardi)
        disCeb = Round(RitMed +(10*DevStd),2)
        ScaCeb = Round(disCeb - RitMese,2)
        s = RimuoviLastChr(s,".")
        ReDim aRisultato(26)
        'Call AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,RitMed,aRit,ritardomax,IncrRitMax,aIncr,ScartoRit,DevStd,disCeb,ScaCeb,nMese(k,1),nMese(k,2),nMese(k,3),nMese(k,4),nMese(k,5),nMese(k,6),nMese(k,7),nMese(k,8),nMese(k,9),nMese(k,10),nMese(k,11),nMese(k,12))
        Call AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,RitMed,aRit,ritardomax,IncrRitMax,aIncr,ScartoRit,DevStd,disCeb,ScaCeb,nMese(k,1),nMese(k,2),nMese(k,3),nMese(k,4),nMese(k,5),nMese(k,6),nMese(k,7),nMese(k,8),nMese(k,9),nMese(k,10),nMese(k,11),nMese(k,12))
        Call AddRigaTabella(aRisultato,,,3,RGB(0,0,0))',"Consolas")
        Call SetColoreCella(Mese(EstrazioneFin) + 13,RGB(215,215,255),2)
    Loop
    Scrivi FormatSpace("script By I Legend per lottoCed's amici",150,- 1)
    Scrivi
    Scrivi "Tabella Statistica per formazioni libere" & " ",1,,RGB(252,227,143),,5
    Scrivi
    Scrivi "Range Ricerca Estrazioni dal :{" & DataEstrazione(Ini) & " } al : {" & DataEstrazione(Fin) & "}",1,,,,3
    Scrivi "Estrazioni Totali Analizzati :{" & nEstr & "}",1,,,,3
    Scrivi "Numeri di ricerca            :{" & StringaNumeri(nNumeri) & "}",1,,,,3
    Scrivi "Sviluppo numeri in           :{" & k & " " & NomeCombinazione(nCombinazione) & "}",1,,,,3
    Scrivi "Analesi combinazione per     :{" & NomeSorte(nSorte) & "}",1,,,,3
    Scrivi "Ciclo Teorico                :{" & nValore & "}",1,,,,3
    Scrivi "Frequenza Teorica            :{" & freqTeorica & "}",1,,,,3
    Scrivi "Ruota di ricerca             :{" & NomeRuota(aRu(1)) & "}",1,,,,3
    Scrivi "ListaRitari                  :" & ArrayRitardi(aRetRitardi)'IncMax(aRetRitardi)'TipOrd & "}",1,,,,3
    Scrivi
    Call SetTableWidth("100%")
    Call CreaTabellaOrdinabile
End Sub
' riporto qui di seguito tutte le funzioni utilizzate
' per la sub main
' ovviamente possono essere ottimizzate
Sub AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,RitMed,aRit,ritardomax,IncrRitMax,aIncr,ScartoRit,DevStd,disCeb,ScaCeb,Gen,Feb,Mar,Apr,Mag,Giu,Lug,Ago,Stt,Ott,Nov,Dic)
    aRisultato(1) = k ' 
    aRisultato(2) = s ' 
    aRisultato(3) = FreqTot'
    aRisultato(4) = Scarto ' 
    aRisultato(5) = RitMese ' 
    aRisultato(6) = RitMed ' 
    aRisultato(7) = aRit
    aRisultato(8) = ritardomax ' 
    aRisultato(9) = IncrRitMax ' 
    aRisultato(10) = aIncr ' incremento degli ultimi ritardi
    aRisultato(11) = ScartoRit
    aRisultato(12) = DevStd ' 
    aRisultato(13) = disCeb '
    aRisultato(14) = ScaCeb ' 
    aRisultato(15) = Gen 
    aRisultato(16) = Feb'Gennaio ' frequenza per mese
    aRisultato(17) = Mar 'Gennaio ' frequenza per mese
    aRisultato(18) = Apr 'Gennaio ' frequenza per mese
    aRisultato(19) = Mag 'Gennaio ' frequenza per mese
    aRisultato(20) = Giu 'Gennaio ' frequenza per mese
    aRisultato(21) = Lug 'Gennaio ' frequenza per mese
    aRisultato(22) = Ago 'Gennaio ' frequenza per mese
    aRisultato(23) = Stt 'Gennaio ' frequenza per mese
    aRisultato(24) = Ott 'Gennaio ' frequenza per mese
    aRisultato(25) = Nov 'Gennaio ' frequenza per mese
    aRisultato(26) = Dic 'Gennaio ' frequenza per mese
End Sub
Function ImpostaParametri(aNumeri,nCombinazione,nSorte,Ctr,aRu,Ruota,Ini)
    'Function ImpostaParametri(aNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,aRu,Ruota,Ini)
    Dim bRet
    Ini = InizioArchivio(3914)
    If Ini > 0 Then
        Call ScegliNumeri(aNumeri)
        If IsArray(aNumeri) Then
            nCombinazione = ScegliCombinazione
            If nCombinazione > 0 Then
                nSorte = SelEsito
                If nSorte > 0 Then
                    Do While nCombinazione < nSorte
                        MsgBox "hai inserito Un Valore errato riscrivi ": nSorte = CInt(SelEsito)
                        If nSorte = - 1 Then Exit Do
                    Loop
                    If nSorte > 0 Then
                        Ruota = SelRuota ' funziona per selezionare la ruota  statistica su tutte o solo per una ruota
                        If Ruota > 0 Then
                            aRu(1) = Ruota
                            If Ruota = 11 Then
                                Ctr = 10
                            Else
                                Ctr = 1 ' valore utilizzato per calcolo del ciclo teorico
                            End If
                        End If
                        bRet = True
                    End If
                End If
            End If
        End If
    End If
    ImpostaParametri = bRet
End Function
Function TrovaFrequenzaMese(aNumeri,aRu,nSorte,Ini,fin,nMese)
    Dim k
    Dim FreqMese
    FreqMese = SerieFreqTurbo(Ini,fin,aNumeri,aRu,nSorte)
    TrovaFrequenzaMese = FreqMese
End Function
Sub ImpostaEstrazioniAttivePerMese(nMese,Ini,fin)
    Dim k
    If nMese = "TUTTI" Then
        Call ResetEstrazioniAttive(nMese,Ini,fin)
    Else
        For k = Ini To fin
            If Mese(k) = nMese Then
                Call ImpostaEstrazione(k,True)
            Else
                Call ImpostaEstrazione(k,False)
            End If
        Next
    End If
End Sub
Sub ResetEstrazioniAttive(nMese,Ini,fin)
    Dim k
    For k = Ini To fin
        Call ImpostaEstrazione(k,True)
    Next
End Sub
Function TrovaRitardoMese(aNumeri,aRu,nSorte,Ini,fin,nMese)
    Dim k
    Dim RitMese
    If nMese <> "TUTTI" Then
        Call ImpostaEstrazioniAttivePerMese(nMese,Ini,fin)
    End If
    RitMese = SerieRitardoTurbo(Ini,fin,aNumeri,aRu,nSorte)
    TrovaRitardoMese = RitMese
End Function
Function NomeCombinazione(a)
    Dim ris
    Select Case a
    Case 1
        ris = "Estratti"
    Case 2
        ris = "Ambi"
    Case 3
        ris = "Terzine"
    Case 4
        ris = "Quartine"
    Case 5
        ris = "Cinquine"
    End Select
    NomeCombinazione = ris
End Function
Function ScegliCombinazione
    Dim ret
    Dim aVoci
    ' gli array partono sempre da 0
    aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine")
    ret = ScegliOpzioneMenu(aVoci,3," Combina i numeri In :")
    ' serve per gestire il tasto annulla
    ScegliCombinazione = ret
End Function
Function SelEsito
    Dim ret
    Dim aVoci
    ' gli array partono sempre da 0
    aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
    ret = ScegliOpzioneMenu(aVoci,2," Analesi per Sorte di : ")
    SelEsito = ret
End Function
Function SelRuota
    Dim ret
    Dim aVoci
    ' gli Array partono sempre da 0
    aVoci = Array("","BARI","CAGLIARI","FIRENZE","GENOVA","MILANO","NAPOLI","PALERMO","ROMA","TORINO","VENEZIA","TUTTE","NAZIONALE")
    ret = ScegliOpzioneMenu(aVoci,1," Analizza Ruota di : ")
    SelRuota = ret
End Function
Function InizioArchivio(nInizio)
    Dim es
    Dim ret
    ReDim aVoci(EstrazioneFin)
    For es = nInizio To EstrazioneFin
        aVoci(es) = DataEstrazione(es)
    Next
    ret = ScegliOpzioneMenu(aVoci,nInizio,"Inserisci Data Inizio Analisi")
    InizioArchivio = ret
End Function
Function RitardoMedio(aRitardi())
    Dim k
    Dim nElementi
    Dim nMedia
    For k = 1 To UBound(aRitardi) - 1
        nElementi = nElementi + 1
        nMedia = nMedia + aRitardi(k)
    Next
    nMedia = Round(Dividi(nMedia,nElementi),2)
    RitardoMedio = nMedia
End Function
Function CalcolaDeviazioneStd(aRitardi())
    Dim k
    Dim somRit,nMedia,nElementi,nVarianza,nSomSQVar
    For k = 1 To UBound(aRitardi) - 1
        nElementi = nElementi + 1
        somRit = somRit + aRitardi(k)
    Next
    nMedia = Round(Dividi(somRit,nElementi))
    For k = 1 To UBound(aRitardi) - 1
        nSomSQVar = nSomSQVar +((nMedia - aRitardi(k)) ^ 2)
        nVarianza = Round(Dividi(nSomSQVar,nElementi),2)
    Next
    CalcolaDeviazioneStd = Round(Sqr(nVarianza),2)
End Function
Function ContaEstrazioni(Ini,Fin,r)
    Dim Conta,es
    For es = Ini To Fin
        If SommaEstratti(es,r) >= 15 Then Conta = Conta + 1
    Next
    ContaEstrazioni = Conta
End Function
Function UltimiRitardi(qRit,aRetRit())
    Dim n1,r1,conta,x
    For x = 1 To UBound(aRetRit) - 1
        conta = conta + 1
    Next
    If conta = 0 Then
        UltimiRitardi = "N.P"
    ElseIf qRit > conta Then
        qRit = conta
    ElseIf conta > qRit Then
        For n1 = UBound(aRetRit) - 1 To UBound(aRetRit) - qRit Step - 1
            r1 = Format2(aRetRit(n1)) & "." & r1
            r1 = RimuoviLastChr(r1,".")
        Next
        UltimiRitardi = r1
    End If
End Function
Function ArrayRitardi(aRetRit())
    Dim n1,r1
    For n1 = 1 To UBound(aRetRit)
        r1 = Format2(aRetRit(n1)) & "." & r1
        r1 = RimuoviLastChr(r1,".")
    Next
    ArrayRitardi = r1
End Function
Function GetArrayDiffRitMax(aRitardi,aRetDiff)
    Dim idMax,idTmp
    Dim nQDiff
    Call OrdinaMatrice(aRitardi,1)
    nQDiff = 0
    ReDim aRetDiff(nQDiff)
    idMax = UBound(aRitardi)
    Do While idMax > 0
        idTmp = idMax - 1
        If idTmp > 0 Then
            nQDiff = nQDiff + 1
            ReDim Preserve aRetDiff(nQDiff)
            aRetDiff(nQDiff) = aRitardi(idMax) - aRitardi(idTmp)
        Else
            Exit Do
        End If
        idMax = idMax - 1
    Loop
End Function

Ciao e buona notte

Ciao I legend complimenti per tutto il tuo lavoro! Mi piacerebbe provarlo perchè sono molto intrigato dall'incmax di III livello che sembra tu riesca a rilevare con questo tuo script!

Però tutte le volte che lo eseguo mi da questo errore per adesso...

Grazie mille (anche a nome dei miei 2 neuroni...

), se e quando l'avrai risolto, posterai lo script per intero a beneficio di tutti/e e non solo la funzione da implementare

. Ciao e Good Sunday a te e al mitico sovrumano Luigi

i legend · 26 Gennaio 2015

Ciao Tom , praticamente quello è il pezzo di codice che devo corregere, Luigi mi ha detto come fare, se ci riesco posto tutto stasera.Ciao
e buona giornata

i legend · 26 Gennaio 2015

ciao a tutti,
Luigi credo di aver risolto perchè sbagliavo la funzione, e ho capito la grandezza e flessibilità della tua

Ora però credo di avere alcuni bugs,
1) nella funzione elenca ultimi Ritardi mi da i ritardi ordinati, non gli ultimi cronologici, e non chiamo Ordina matrice
2) se seleziono 3 numeri sviluppo terzine per ambo esce errore, potresti provare tu?
Credo che questo essendo uno script statisico necessiti di queste due funzioni che lo arricchiscono notevolmente..

Quando puoi

Grazie mille,
Di seguito lo script Completo

Codice:

Option Explicit
Sub Main
    Dim Ini,Fin,nEstr,es,k,x,r,nValore,idOrd,TipOrd,Ctr,z,U3Incr,IdMax,aRetDiff,sIncrementi,conta
    Dim DevStd,disCeb,ScaCeb,qIncr
    Dim nColTotSvil
    Dim s,e,ritardo,ritardomax,IncrRitMax,RitMed,RitMese,ScartoRit,URit
    Dim Frequenza,freqTeorica,FreqMese,freq,FreqTot,Scarto
    Dim nNumeri,aColonne
    ReDim aNumeri(0)
    Dim aRu(1)
    Dim nCombinazione,nSorte,nCiclo
    Dim aTitolo
    ReDim aRetRitardi(0)
    ReDim aRetIdEstr(0)
    Fin = EstrazioneFin
    qIncr=3 ' qui seleziono quanti incrementi voglio
    If ImpostaParametri(nNumeri,nCombinazione,nSorte,Ctr,aRu,r,Ini) = False Then
        'If ImpostaParametri(nNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,aRu,r,Ini) = False Then
        MsgBox "Parametri non corretti",vbCritical
        Exit Sub
    End If
    'Imposto i titoli delle colonne della tabella statistica
    aTitolo = Array("","ID","Comb","freq","Scarto","Rit","RitMed","U5Rit","RitSto","IncR.s","U3Incr","ScartoRit","DevStd","disCeb","ScaCeb99%","GEN","FEB","MAR","APR","MAG","GIU","LUG","AGO","Set","OTT","NOV","DIC")
    InitTabella aTitolo,RGB(221,221,221),,3,vbBlack', "Consolas"
    'conto le estrazioni utili
    nEstr = ContaEstrazioni(Ini,Fin,r)
    nValore = Round(CicloTeorico(nCombinazione,nSorte,CInt(Ctr)),2)' ctr= 1 (=1R);=10(=TT)
    freqTeorica = Round(Dividi(nEstr,nValore),2)
    'aColonne = SviluppoIntegrale(nNumeri,nCombinazione) ' sviluppo i l'array dei numeri scelti ,nella combinazione scelta
    ReDim aColSviluppo(0)
    nColTotSvil = Combinazioni(UBound(nNumeri),nCombinazione)
    ReDim nMese(nColTotSvil,12)
    For z = 1 To 12
        Call ImpostaEstrazioniAttivePerMese(z,Ini,Fin)
        nColTotSvil = InitSviluppoIntegrale(nNumeri,nCombinazione)
        k = 0
        Do While GetCombSviluppo(aColSviluppo)
            k = k + 1
            nMese(k,z) = TrovaFrequenzaMese(aColSviluppo,aRu,nSorte,Ini,Fin,z)
        Loop
    Next
    Call ResetEstrazioniAttive(z,Ini,Fin)
    k = 0
    nColTotSvil = InitSviluppoIntegrale(nNumeri,nCombinazione)
    Do While GetCombSviluppo(aNumeri)
        k = k + 1
        'For k = 1 To UBound(aColonne) ' ciclo per leggere la colonna k della matrice aColonne
        's = "" ' dichiaro la stringa combinazione vuota
        Messaggio "Elaborazione in corso id sviluppo: " & k
        AvanzamentoElab 1,nColTotSvil,k
        If ScriptInterrotto Then Exit Do
        s = StringaNumeri(aNumeri,,True)
        Call StatisticaFormazioneTurbo(aNumeri,aRu,nSorte,ritardo,ritardomax,IncrRitMax,Frequenza,Ini,Fin)
        FreqTot = Frequenza
        ' funzione per calcolare il ritardo globale della formazione
        ' questo è un espediente che ho dovuto analizzare visto la frequenza mese
        RitMese = TrovaRitardoMese(aNumeri,aRu,nSorte,Ini,Fin,"TUTTI")
        Scarto = Round(FreqTot - freqTeorica,2)
        ScartoRit = Round(ritardomax - ritardo,2)
        ' richiamo la funzione elenca ritardi, per poter attingere alla marice che elenca i ritardi  voce:( aRetRitardi)
        Call ElencoRitardiTurbo(aNumeri,aRu,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr)
        Call GetArrayDiffRitMax(aRetRitardi,aRetDiff)
        IdMax = UBound(aRetRitardi) - 1
        sIncrementi = ""
        conta = 0
        For k = 1 To UBound(aRetDiff)
            conta = conta + 1
            If conta <= qIncr Then
                sIncrementi = aRetDiff(k) & "." & sIncrementi
                IdMax = IdMax - 1
            Else
                Exit For
            End If
        Next
        sIncrementi = RimuoviLastChr(sIncrementi,".")
        ' scritta funzione per calcolare il ritardo medio della formazione
        RitMed = RitardoMedio(aRetRitardi)
        URit = UltimiRitardi(aRetRitardi)
        U3Incr = sIncrementi 'OrdIncrementiMax(aRetRitardi)
        ' scritta funzione per calcolo deviazione standard della funzione
        '
        DevStd = CalcolaDeviazioneStd(aRetRitardi)
        disCeb = Round(RitMed +(10*DevStd),2)
        ScaCeb = Round(disCeb - RitMese,2)
        s = RimuoviLastChr(s,".")
        ReDim aRisultato(26)
        Call AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,RitMed,URit,ritardomax,IncrRitMax,U3Incr,ScartoRit,DevStd,disCeb,ScaCeb,nMese(k,1),nMese(k,2),nMese(k,3),nMese(k,4),nMese(k,5),nMese(k,6),nMese(k,7),nMese(k,8),nMese(k,9),nMese(k,10),nMese(k,11),nMese(k,12))
        Call AddRigaTabella(aRisultato,,,3,RGB(0,0,0))',"Consolas")
        'se decidessi di ordinare il mese? legge il primo colore? No Legge l'ultima istruzione
        'Call SetColoreCella(CInt(idOrd),RGB(221,255,230),2)
        Call SetColoreCella(Mese(EstrazioneFin) + 13,RGB(215,215,255),2)
    Loop
    Scrivi FormatSpace("script By I Legend per lottoCed's amici",150,- 1)
    Scrivi
    Scrivi "Tabella Statistica per formazioni libere" & " ",1,,RGB(252,227,143),,5
    Scrivi
    Scrivi "Range Ricerca Estrazioni dal :{" & DataEstrazione(Ini) & " } al : {" & DataEstrazione(Fin) & "}",1,,,,3
    Scrivi "Estrazioni Totali Analizzati :{" & nEstr & "}",1,,,,3
    Scrivi "Numeri di ricerca            :{" & StringaNumeri(nNumeri) & "}",1,,,,3
    Scrivi "Sviluppo numeri in           :{" & k & " " & NomeCombinazione(nCombinazione) & "}",1,,,,3
    Scrivi "Analesi combinazione per     :{" & NomeSorte(nSorte) & "}",1,,,,3
    Scrivi "Ciclo Teorico                :{" & nValore & "}",1,,,,3
    Scrivi "Frequenza Teorica            :{" & freqTeorica & "}",1,,,,3
    Scrivi "Ruota di ricerca             :{" & NomeRuota(aRu(1)) & "}",1,,,,3
    Scrivi "Elenco rit formazione        :{" & ArrayRitardi(aRetRitardi)'aTitolo(idOrd) & "}",1,,,,3
        Scrivi
    Call SetTableWidth("100%")
    'If TipOrd = 1 Then Call AddRigaTabella(aTitolo,RGB(108,194,243),,3,vbWhite)',"Consolas")
    'Call CreaTabella(idOrd,TipOrd,0)
    Call CreaTabellaOrdinabile
    'If ScriptInterrotto Then Exit Sub
End Sub
' riporto qui di seguito tutte le funzioni utilizzate
' per la sub main
' ovviamente possono essere ottimizzate
Sub AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,RitMed,URit,ritardomax,IncrRitMax,U3Incr,ScartoRit,DevStd,disCeb,ScaCeb,Gen,Feb,Mar,Apr,Mag,Giu,Lug,Ago,Stt,Ott,Nov,Dic)
    aRisultato(1) = k ' id
    aRisultato(2) = s ' combinazioni analizzate
    aRisultato(3) = FreqTot'frequenza combinazione
    aRisultato(4) = Scarto ' differenza freq.reeale e differenza teorica
    aRisultato(5) = RitMese ' ritardo cronologico
    aRisultato(6) = RitMed ' ritardo medio
    aRisultato(7) = URit
    aRisultato(8) = ritardomax ' ritardo storico
    aRisultato(9) = IncrRitMax ' incremento ritardo storico
    aRisultato(10) = U3Incr ' incremento ritardo storico
    aRisultato(11) = ScartoRit
    aRisultato(12) = DevStd ' deviazione standard
    aRisultato(13) = disCeb 'disegualianza di cebicev
    aRisultato(14) = ScaCeb ' scarto tra valore ipotizzato e valore del ritardo reale
    aRisultato(15) = Gen 'Gennaio ' frequenza per mese
    aRisultato(16) = Feb'Gennaio ' frequenza per mese
    aRisultato(17) = Mar 'Gennaio ' frequenza per mese
    aRisultato(18) = Apr 'Gennaio ' frequenza per mese
    aRisultato(19) = Mag 'Gennaio ' frequenza per mese
    aRisultato(20) = Giu 'Gennaio ' frequenza per mese
    aRisultato(21) = Lug 'Gennaio ' frequenza per mese
    aRisultato(22) = Ago 'Gennaio ' frequenza per mese
    aRisultato(23) = Stt 'Gennaio ' frequenza per mese
    aRisultato(24) = Ott 'Gennaio ' frequenza per mese
    aRisultato(25) = Nov 'Gennaio ' frequenza per mese
    aRisultato(26) = Dic 'Gennaio ' frequenza per mese
End Sub
Function ImpostaParametri(aNumeri,nCombinazione,nSorte,Ctr,aRu,Ruota,Ini)
    'Function ImpostaParametri(aNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,aRu,Ruota,Ini)
    Dim bRet
    Ini = InizioArchivio(3914)
    If Ini > 0 Then
        Call ScegliNumeri(aNumeri)
        If IsArray(aNumeri) Then
            nCombinazione = ScegliCombinazione
            If nCombinazione > 0 Then
                nSorte = SelEsito
                If nSorte > 0 Then
                    'If nCombinazione < nSorte Then MsgBox "hai inserito Un Valore errato riscrivi ": nSorte = CInt(SelEsito)
                    Do While nCombinazione < nSorte
                        MsgBox "hai inserito Un Valore errato riscrivi ": nSorte = CInt(SelEsito)
                        If nSorte = - 1 Then Exit Do
                    Loop
                    If nSorte > 0 Then
                        Ruota = SelRuota ' funziona per selezionare la ruota  statistica su tutte o solo per una ruota
                        If Ruota > 0 Then
                            aRu(1) = Ruota
                            If Ruota = 11 Then
                                Ctr = 10
                            Else
                                Ctr = 1 ' valore utilizzato per calcolo del ciclo teorico
                            End If
                            'idOrd = Ordinamento ' seleziono la colonna che voglio ordinare
                            'If idOrd > 0 Then
                            'TipOrd = TipoOrdinamento ' Crescente o decrescente
                            'bRet = True ' per default torna true
                            'End If
                            'bRet = True
                        End If
                        bRet = True
                    End If
                End If
            End If
        End If
    End If
    ImpostaParametri = bRet
End Function
Function TrovaFrequenzaMese(aNumeri,aRu,nSorte,Ini,fin,nMese)
    Dim k
    Dim FreqMese
    FreqMese = SerieFreqTurbo(Ini,fin,aNumeri,aRu,nSorte)
    TrovaFrequenzaMese = FreqMese
End Function
Sub ImpostaEstrazioniAttivePerMese(nMese,Ini,fin)
    Dim k
    If nMese = "TUTTI" Then
        Call ResetEstrazioniAttive(nMese,Ini,fin)
    Else
        For k = Ini To fin
            If Mese(k) = nMese Then
                Call ImpostaEstrazione(k,True)
            Else
                Call ImpostaEstrazione(k,False)
            End If
        Next
    End If
End Sub
Sub ResetEstrazioniAttive(nMese,Ini,fin)
    Dim k
    For k = Ini To fin
        Call ImpostaEstrazione(k,True)
    Next
End Sub
Function TrovaRitardoMese(aNumeri,aRu,nSorte,Ini,fin,nMese)
    Dim k
    Dim RitMese
    If nMese <> "TUTTI" Then
        Call ImpostaEstrazioniAttivePerMese(nMese,Ini,fin)
    End If
    RitMese = SerieRitardoTurbo(Ini,fin,aNumeri,aRu,nSorte)
    TrovaRitardoMese = RitMese
End Function
Function NomeCombinazione(a)
    Dim ris
    Select Case a
    Case 1
        ris = "Estratti"
    Case 2
        ris = "Ambi"
    Case 3
        ris = "Terzine"
    Case 4
        ris = "Quartine"
    Case 5
        ris = "Cinquine"
    End Select
    NomeCombinazione = ris
End Function
Function Ordinamento
    Dim Ord
    Dim ret
    Dim aTitolo
    ' gli array partono sempre da 0
    aTitolo = Array("","","","freq","Scarto","Rit","RitMed","RitSto","IncR.s","DevStd","disCeb","ScaCeb99%","GEN","FEB","MAR","APR","MAG","GIU","LUG","AGO","Set","OTT","NOV","DIC")
    ret = ScegliOpzioneMenu(aTitolo,3,"Seleziona Ordinamento  per la colonna :")
    ' serve per gestire il tasto annulla
    If ret >= 0 Then
        Ord = ret
    Else
        Ord = ret
    End If
    Ordinamento = Ord
End Function
Function TipoOrdinamento
    Dim Ord
    Dim ret
    Dim aTitolo
    aTitolo = Array("","Crescente","DeCrescente")
    ret = ScegliOpzioneMenu(aTitolo,1,"Seleziona Tipo di Ordinamento  :")
    ' serve per gestire il tasto annulla
    If ret >= 0 Then
        If ret = 1 Then Ord = 1 : Else Ord = - 1
    Else
        Ord = ret
    End If
    TipoOrdinamento = Ord
End Function
Function ScegliCombinazione
    Dim ret
    Dim aVoci
    ' gli array partono sempre da 0
    aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine")
    ret = ScegliOpzioneMenu(aVoci,3," Combina i numeri In :")
    ' serve per gestire il tasto annulla
    ScegliCombinazione = ret
End Function
Function SelEsito
    Dim ret
    Dim aVoci
    ' gli array partono sempre da 0
    aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
    ret = ScegliOpzioneMenu(aVoci,2," Analesi per Sorte di : ")
    SelEsito = ret
End Function
Function SelRuota
    Dim ret
    Dim aVoci
    ' gli Array partono sempre da 0
    aVoci = Array("","BARI","CAGLIARI","FIRENZE","GENOVA","MILANO","NAPOLI","PALERMO","ROMA","TORINO","VENEZIA","TUTTE","NAZIONALE")
    ret = ScegliOpzioneMenu(aVoci,1," Analizza Ruota di : ")
    SelRuota = ret
End Function
Function InizioArchivio(nInizio)
    Dim es
    Dim ret
    ReDim aVoci(EstrazioneFin)
    For es = nInizio To EstrazioneFin
        aVoci(es) = DataEstrazione(es)
    Next
    ret = ScegliOpzioneMenu(aVoci,nInizio,"Inserisci Data Inizio Analisi")
    InizioArchivio = ret
End Function
Function RitardoMedio(aRitardi())
    Dim k
    Dim nElementi
    Dim nMedia
    For k = 1 To UBound(aRitardi) - 1
        nElementi = nElementi + 1
        nMedia = nMedia + aRitardi(k)
    Next
    nMedia = Round(Dividi(nMedia,nElementi),2)
    RitardoMedio = nMedia
End Function
Function CalcolaDeviazioneStd(aRitardi())
    Dim k
    Dim somRit,nMedia,nElementi,nVarianza,nSomSQVar
    For k = 1 To UBound(aRitardi) - 1
        nElementi = nElementi + 1
        somRit = somRit + aRitardi(k)
    Next
    nMedia = Round(Dividi(somRit,nElementi))
    For k = 1 To UBound(aRitardi) - 1
        nSomSQVar = nSomSQVar +((nMedia - aRitardi(k)) ^ 2)
        nVarianza = Round(Dividi(nSomSQVar,nElementi),2)
    Next
    CalcolaDeviazioneStd = Round(Sqr(nVarianza),2)
End Function
Function ContaEstrazioni(Ini,Fin,r)
    Dim Conta,es
    For es = Ini To Fin
        If SommaEstratti(es,r) >= 15 Then Conta = Conta + 1
    Next
    ContaEstrazioni = Conta
End Function
Function UltimiRitardi(aRetRit())
    Dim n1,r1,conta,qRit
    qRit = 5 ' qui seleziono 5 Ritardi
    For n1 = UBound(aRetRit) - 1 To LBound(aRetRit) Step - 1
        conta = conta + 1
        If conta <= qRit Then
            r1 = Format2(aRetRit(n1)) & "." & r1
            r1 = RimuoviLastChr(r1,".")
        Else
            Exit For
        End If
    Next
    UltimiRitardi = r1
End Function
Function ArrayRitardi(aRetRit())
    Dim n1,r1
    For n1 = LBound(aRetRit) To UBound(aRetRit)-1
        r1 = Format2(aRetRit(n1)) & "." & r1
    Next
    r1 = RimuoviLastChr(r1,".")
    ArrayRitardi = r1
End Function
Function GetArrayDiffRitMax(aRitardi,aRetDiff)
    Dim idMax,idTmp
    Dim nQDiff
    Call OrdinaMatrice(aRitardi,1)
    nQDiff = 0
    ReDim aRetDiff(nQDiff)
    idMax = UBound(aRitardi)-1
    Do While idMax > 0
        idTmp = idMax - 1
        If idTmp > 0 Then
            nQDiff = nQDiff + 1
            ReDim Preserve aRetDiff(nQDiff)
            aRetDiff(nQDiff) = aRitardi(idMax) - aRitardi(idTmp)
        Else
            Exit Do
        End If
        idMax = idMax - 1
    Loop
End Function

LuigiB · 27 Gennaio 2015

ciao Legend , ElencoRitardi non torna arrray ordinati ... pero se passi quell'array alla funzione che abbiamo scritto noi è quella che lo ordina e poi rimane ovviamente ordinato ...
Continua a lavorarci e fai finta ched io non sappia nulla ...il metodo migliore per imparare è cercare di capire da soli ..le informazioni di base ce l'hai sia perche te le ho date io sia perche anche gli altri utenti ti hanno aiutato in altri script.

i legend · 27 Gennaio 2015

Ciao Luigi, quello che dici è vero, bisogna che ci lavoro su ,per imparare.Intanto ti ringrazio per la funzione che hai scritto e per tutte le spiegazioni che mi dai

. Ovviamente lo script è per tutti , chiunque voglia lavorarci su è il benvenuto

, non solo per il codice ma anche per dare suggerimenti e richieste.Intanto provo a calcolare gli ultimi ritardi direttamente nella sub , prima di chiamare la funzione OrdinaMatrice.
Dovrei costruire una funzione tipo Reset come quella per i mesi.Almeno cosi tengo i neuroni occupati

Grazie mille

i legend · 27 Gennaio 2015

Ciao aggiorno sullo script:
il problema dell'elenco ritardi in ordine cronologico si risolve scrivendo la funzione

Codice:

Call ElencoRitardiTurbo(aNumeri,aRu,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr)
            r1 = ""
        conta1 = 0
        For n1 = UBound(aRetRitardi) - 1 To LBound(aRetRitardi) Step - 1
            conta1 = conta1 + 1
            If conta1 <= qRit Then
                r1 = Format2(aRetRitardi(n1)) & "." & r1
            Else
                Exit For
            End If
        Next
        r1 = RimuoviLastChr(r1,".")
        aRitardi = r1

Allora scrivendo questo codice sotto elenco ritardi si risolve il problema , ma non funziona più frequenza mese, praticamente copia sempre i risultati della prima riga.....
Mi spiace ma ne verrò a capo

Tom se sei interessato solo agli ultimi incrementi e non ti importa la frequenza per mese, verifico che tutti i calcoli siano corretti e ti posto lo script, fammi sapere, ciao

lotto_tom75 · 27 Gennaio 2015

i legend ha scritto:
Ciao aggiorno sullo script:
il problema dell'elenco ritardi in ordine cronologico si risolve scrivendo la funzione

Codice:

Call ElencoRitardiTurbo(aNumeri,aRu,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr) r1 = "" conta1 = 0 For n1 = UBound(aRetRitardi) - 1 To LBound(aRetRitardi) Step - 1 conta1 = conta1 + 1 If conta1 <= qRit Then r1 = Format2(aRetRitardi(n1)) & "." & r1 Else Exit For End If Next r1 = RimuoviLastChr(r1,".") aRitardi = r1

Allora scrivendo questo codice sotto elenco ritardi si risolve il problema , ma non funziona più frequenza mese, praticamente copia sempre i risultati della prima riga.....
Mi spiace ma ne verrò a capo
Tom se sei interessato solo agli ultimi incrementi e non ti importa la frequenza per mese, verifico che tutti i calcoli siano corretti e ti posto lo script, fammi sapere, ciao

Tom se sei interessato solo agli ultimi incrementi e non ti importa la frequenza per mese, verifico che tutti i calcoli siano corretti e ti posto lo script, fammi sapere, ciao

Faccio benissimo a meno della freq in questione

Grazie 1000 per il resto non vedo l'ora di testarlo Ciao!

i legend · 27 Gennaio 2015

Ciao Tom, intanto posto due Figure, penso di aver sistemato tutto, ma dato che utilizzo solo spaziometria come programma avrei bisogno che qualcuno verificasse la veridicità dell'output . non vorrei commettere errori.

Questa sopra potrebbe essere un ipotesi di previsione visto che non ha mai superato un incremento di 2
ora imagine per verifica output:

Se Risulta corretto
posto lo script
Ciao e grazie a tutti

vincenzo4221 · 30 Gennaio 2015

E' CORRETTO ,Legend , puoi postarlo? siamo in attesa, grazie , vincenzo

lotto_tom75 · 30 Gennaio 2015

vincenzo4221 ha scritto:
E' CORRETTO ,Legend , puoi postarlo? siamo in attesa, grazie , vincenzo

Mi associo all'attesa

Ciao!

Funzione incRitMax

LuigiB

Guest

Premium Member

Premium Member

LuigiB

Guest

Premium Member

Premium Member

Premium Member

LuigiB

Guest

LuigiB

Guest

Premium Member

Advanced Premium Member

Premium Member

Premium Member

LuigiB

Guest

Premium Member

Premium Member

Advanced Premium Member

Premium Member

Advanced Member >PLATINUM<

Advanced Premium Member