Cortesia agli esperti di listati

[solare]

Chiedo se possibile aggiungere la possibilità di poter selezionare l'elaborazione su due ruote anziché uno.......Grazie
Option Explicit
Sub Main
' Si prega sempre di verificare e confrontare i risultatiottenuti dallo script con altre fonti
' per verificarne la correttezza
' se si dovessero verificare bugs segnalarli per le opportune correzioni.
'
Dim Ini,Fin,nEstr,es,k,x,r,nValore,idOrd,TipOrd,Ctr,z
Dim r1,n1,qRit,conta1
Dim scartoRit,Gen,Feb,Mar,Apr,Mag,Giu,Lug,Ago,Sett,Ott,Nov,Dic
Dim IdMax,aRetDiff,Conta,aIncr,Sincrementi,qIncr,y
Dim DevStd,disCeb,ScaCeb,aRitardi
Dim nColTotSvil
Dim s,e,ritardo,ritardomax,IncrRitMax,RitMed,RitMese
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
qRit = 10 ' elenco ultimi N_Ritardi
qIncr = 5 ' elenco ultimi N_incrementi
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","aRitardi","RitMed","RitSto","IncR.s","aIncrementi","ScartoRit","DevStd","disCeb","ScaCeb99%","Gen ","Feb","Mar","Apr","Mag","Giu","Lug","Ago","Set","Ott","Nov","Dic")
InitTabella aTitolo,RGB(108,194,243),,3,vbWhite', "Consolas"
nEstr = ContaEstrazioni(Ini,Fin,r)
nValore = Round(CicloTeorico(nCombinazione,nSorte,CInt(Ctr)),2)' ctr= 1 (=1R);=10(=TT)
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)
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 = FormattaStringa(aRetRitardi(n1),"000") & "." & r1
Else
Exit For
End If
Next
r1 = RimuoviLastChr(r1,".")
aRitardi = r1
RitMed = RitardoMedio(aRetRitardi)
DevStd = CalcolaDeviazioneStd(aRetRitardi)
disCeb = Round(RitMed +(10*DevStd),2)
ScaCeb = Round(disCeb - RitMese,2)
Call GetArrayDiffRitMax(aRetRitardi,aRetDiff)
IdMax = UBound(aRetRitardi) - 1
Sincrementi = ""
Conta = 0
For y = 1 To UBound(aRetDiff)
Conta = Conta + 1
If Conta <= qIncr Then
Sincrementi = FormattaStringa(aRetDiff,"000") & "." & Sincrementi
IdMax = IdMax - 1
Else
Exit For
End If
Next
Sincrementi = RimuoviLastChr(Sincrementi,".")
aIncr = Sincrementi
s = RimuoviLastChr(s,".")
ReDim aRisultato(26)
Call AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,aRitardi,RitMed,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(2,RGB(215,215,255),2)
Loop
Scrivi FormatSpace("script By I Legend per lottoCed's amici",10,- 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

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,aRitardi,RitMed,ritardomax,IncrRitMax,aIncr,scartoRit,DevStd,disCeb,ScaCeb,Gen,Feb,Mar,Apr,Mag,Giu,Lug,Ago,Sett,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) = aRitardi
aRisultato(7) = RitMed ' ritardo medio
aRisultato(8) = ritardomax ' ritardo storico
aRisultato(9) = IncrRitMax ' incremento ritardo storico
aRisultato(10) = aIncr
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
aRisultato(16) = Feb
aRisultato(17) = Mar
aRisultato(18) = Apr
aRisultato(19) = Mag
aRisultato(20) = Giu
aRisultato(21) = Lug
aRisultato(22) = Ago
aRisultato(23) = Sett
aRisultato(24) = Ott
aRisultato(25) = Nov
aRisultato(26) = Dic
End Sub
Function ImpostaParametri(aNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,aRu,Ruota,Ini)
Dim bRet
Ini = InizioArchivio(8163)
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
bRet = True ' per default torna true
End If
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 aVoci
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine")
NomeCombinazione = aVoci(a)
End Function
Function ScegliCombinazione
Dim ret
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine")
ret = ScegliOpzioneMenu(aVoci,1," 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,1," 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 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

 

[i legend]

Ciao solare ti segnalo che in questo script che è la prima versione ci sono dei bugs ( errori)
. Era stata postata la versione modificata e corretta.

Ciao

 

[solare]

Caspita, dove posso trovare la versione corretta !!!

 

[i legend]

Da qualche parte nel forum
Ci sono più versioni in giro anche modificati non da ne.
Ciao

 

[solare]

Ok ti ringrazio.
Se qualche amico del forum mi può dare qualche indicazione dove poter trovare ul listato simile.
a servirebbe un listato che analizzi dei numeri che io inserisco e che mi dia una statistica mensile magari con la possibilità di poter analizzare una o due ruote.

 

[Alien.]

Ciao ancora nulla