Ciao questo listato ha degli errori si potrebbe ovviare? grazie
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","aRitar di","RitMed","RitSto","IncR.s","aIncrementi","Scar toRit","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,ritar do,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,aRet Ritardi,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(y),"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,Scart o,RitMese,aRitardi,RitMed,ritardomax,IncrRitMax,aI ncr,scartoRit,DevStd,disCeb,ScaCeb,nMese(k,1),nMes e(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),nMes e(k,11),nMese(k,12))
Call AddRigaTabella(aRisultato,,,3,RGB(0,0,0))',"Consol as")
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,Scart o,RitMese,aRitardi,RitMed,ritardomax,IncrRitMax,aI ncr,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,nMes e)
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","C inquine")
NomeCombinazione = aVoci(a)
End Function
Function ScegliCombinazione
Dim ret
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","C inquine")
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","Cin quina")
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","MIL ANO","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
AA..CERCASI
5 messaggi
• Pagina 1 di 1
Re: AA..CERCASI
da Tony56 il 19/04/2016, 11:54
Quando fai 'girare' lo script il programma (Spaziometria ultima versione)ti evidenzierà una riga dicendoti che c'è un errore:
togli gli spazi nelle varie righe evidenziate delle seguenti scritte che da nere diventeranno fucsia(come gli altri comandi):
ritr Do deve diventare ritrDO
aRet Ritardi " aRetRitardi
aI ncr " alncr
nMes e " nMese
Scart o " Scarto
Corretta una riga continua a far girare il programma sino a che le avrai corrette tutte.
Ricordati il Sub Main all'inizio
Spero di essermi spiegato
Ciao e buona giornata
Tony
togli gli spazi nelle varie righe evidenziate delle seguenti scritte che da nere diventeranno fucsia(come gli altri comandi):
ritr Do deve diventare ritrDO
aRet Ritardi " aRetRitardi
aI ncr " alncr
nMes e " nMese
Scart o " Scarto
Corretta una riga continua a far girare il programma sino a che le avrai corrette tutte.
Ricordati il Sub Main all'inizio
Spero di essermi spiegato
Ciao e buona giornata
Tony
- Tony56
- Messaggi: 8
- Iscritto il: 07/10/2013, 11:25
Re: AA..CERCASI
da ALIEN il 19/04/2016, 21:03
si,ciao veramente è quasi tutto in viola la scritta
il primo errore me lo da con il sub
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
ma tu lo hai provato su spazio ?
grazie.
il primo errore me lo da con il sub
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
ma tu lo hai provato su spazio ?
grazie.
- ALIEN
- Messaggi: 37
- Iscritto il: 24/03/2014, 22:15
Re: AA..CERCASI
da Tony56 il 20/04/2016, 5:23
Con ultima versione di Spazio a me funziona.Ho fatto un copia/incolla
Ciao e buona giornata
Option Explicit
Sub Main
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","aRitar di","RitMed","RitSto","IncR.s","aIncrementi","Scar toRit","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(y),"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))',"Consol as")
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","C inquine")
NomeCombinazione = aVoci(a)
End Function
Function ScegliCombinazione
Dim ret
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","C inquine")
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","Cin quina")
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","MIL ANO","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
Ciao e buona giornata
Option Explicit
Sub Main
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","aRitar di","RitMed","RitSto","IncR.s","aIncrementi","Scar toRit","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(y),"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))',"Consol as")
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","C inquine")
NomeCombinazione = aVoci(a)
End Function
Function ScegliCombinazione
Dim ret
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","C inquine")
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","Cin quina")
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","MIL ANO","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
- Tony56
- Messaggi: 8
- Iscritto il: 07/10/2013, 11:25
Re: AA..CERCASI
da ALIEN il 20/04/2016, 9:34
ho...cavolacci non so cosa è successo ma adesso funziona non mi da nessun errore,non ho istallato nessun aggiornamento in quanto è l'ultimo di spazio...un bel mistero....comunque grazie di tutto.
- ALIEN
- Messaggi: 37
- Iscritto il: 24/03/2014, 22:15
5 messaggi
• Pagina 1 di 1
Chi c’è in linea
Visitano il forum: Nessuno e 2 ospiti