i legend
Premium Member
Ciao Genios, se ho capito bene , il ritardo 1 L = ritardo attuale+ ritardo precedente
Ora nello script hai ritAttuale, ritardo precedente, ritattuale+ritardoi precedente.
Il ritardo medio, è la somma di tutti i ritardi, diviso tutti gli elementi,
Nello script c'è la funzione ritardo medio, Studiala e dimi se fa gia queòllo che cerchi,,,...
x Joe
Ciao joe, scusa se mi sono messo nel post delle tue spiegazioni,,Il tuo aiuto è sempre utilissimo
Ciao buona domenica a tutti
Ecco lo script
Ora nello script hai ritAttuale, ritardo precedente, ritattuale+ritardoi precedente.
Il ritardo medio, è la somma di tutti i ritardi, diviso tutti gli elementi,
Nello script c'è la funzione ritardo medio, Studiala e dimi se fa gia queòllo che cerchi,,,...
x Joe
Ciao joe, scusa se mi sono messo nel post delle tue spiegazioni,,Il tuo aiuto è sempre utilissimo
Ciao buona domenica a tutti
Ecco lo script
Codice:
Option Explicit
Sub Main
'Controllare eventuali Bugs:)
' lo script non esegue la ricerca su tutte e Nazionale
' SE ci dovessero essere bugs segnalateli vediamo di risolverli se possibile
Dim k,s,i,nRuote,j,StrArray
Dim nClasse,nColonneTot
ReDim aNumeri(90)
ReDim aStudio(9)
ReDim aRu(12)
ReDim aCol(0)
Dim Dec,nSorte,sRuote
Dim ritardo,ritardomax,IncrRitMax,Frequenza,Ini,Fin
Dim aTitolo,Freq,RitA,RitS,Scarto,IncrRit
Dim cTeorico,nEstrazioni,FreqTeor,ScaFreq
Dim a,aVoci,aRis
Dim aTitTab1,KK
Dim Form,FormStud,aArrayStudio
Dim aRetRitardi,aRetIdEstr,RitMedio
Dim aRit1,iRit1,iRit1L,n1,conta1
If ImpostaParametri(nClasse,nSorte,Form,FormStud,aStudio,nRuote,aRu) = False Then
MsgBox" I Parametri inseriri sono erratti",vbCritical
Exit Sub
End If
'costruisco intestazione tabella
aTitolo = Array("","ID","Comb","Freq","ScaFreq","RitA","RitP","Rit(A+P)","RitSto","RitMedio","Scarto","IncRitMax")
InitTabella aTitolo,RGB(223,224,243),,3,vbBlack
'Data Inizio Archivio
Ini = 3914
Fin = EstrazioneFin
nEstrazioni = ContaEstrazioni(Ini,Fin,aRu,nRuote)
For k = LBound(aStudio) To UBound(aStudio)
aStudio(k) = aStudio(k)
StrArray = StringaNumeri(aStudio,,True)
Next
For i = UBound(aRu) To 1 Step - 1
sRuote = SiglaRuota(aRu(i)) & "." & sRuote
Next
sRuote = RimuoviLastChr(sRuote,".")
'inizializza lo sviluppo
cTeorico = Round(CicloTeorico(nClasse,nSorte,CInt(nRuote)),2)
FreqTeor = Round(Dividi(nEstrazioni,cTeorico),2)
nColonneTot = InitSviluppoIntegrale(aStudio,nClasse)
k = 0
'a=ContaEstrazioni(Ini,Fin,aRu,nRuote)
Do While GetCombSviluppo(aStudio)
k = k + 1 ' conteggio colonna corrente
Messaggio "Elaborazione in corso id sviluppo: " & k
AvanzamentoElab 1,nColonneTot,k
If ScriptInterrotto Then Exit Do
' costruisco la stringa che contiene la colonna
s = StringaNumeri(aStudio,,True)
Call StatisticaFormazioneTurbo(aStudio,aRu,nSorte,ritardo,ritardomax,IncrRitMax,Frequenza,Ini,Fin)
Freq = Frequenza
RitA = ritardo
RitS = ritardomax
IncrRit = IncrRitMax
ScaFreq = Round((Freq - FreqTeor),2)
Call ElencoRitardiTurbo(aStudio,aRu,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr)
RitMedio = RitardoMedio(aRetRitardi)
iRit1 = ""
conta1 = 0
For n1 = UBound(aRetRitardi) - 1 To LBound(aRetRitardi) Step - 1
conta1 = conta1 + 1
If conta1 <= 1 Then
iRit1 = FormattaStringa(aRetRitardi(n1),"000")
iRit1L=RitA+iRit1
Else
Exit For
End If
Next
ReDim aRisultato(11)
Call AlimentaArrayCombinazioni(aRisultato,k,s,Freq,ScaFreq,RitA,iRit1,iRit1L,RitS,RitMedio,Scarto,IncrRit)
Call AddRigaTabella(aRisultato,,,3,RGB(0,0,0))
Call SetColoreCella(2,RGB(255,236,255),2)
Loop
Scrivi FormatSpace("script By I Legend per lottoCed's amici",10,- 1),1,,,1
Scrivi
Scrivi " Tabella Statistica per formazioni registrate " & " ",1,,RGB(253,245,189),,5
Scrivi
Scrivi "Formazione Ricerca : " & ScriviArrayStudio(Form,FormStud),1,,,,3
Scrivi "Array Ricerca : " & "{" & StrArray & " }",1,,,,3
Scrivi "Sviluppo in : " & ScriviClasse(nClasse),1,,,,3
Scrivi "Ricerca per : " & ScriviEsito(nSorte),1,,,,3
Scrivi "Ciclo Teorico : " & cTeorico,1,,,,3
Scrivi "Freq Teorica : " & FreqTeor,1,,,,3
Scrivi "Ruote di ricerca : " & sRuote,1,,,,3
Scrivi "Num Estrazioni : " & nEstrazioni,1,,,,3
Scrivi
Scrivi
Call CreaTabellaOrdinabile
End Sub
Sub AlimentaArrayCombinazioni(aRisultato,k,s,Freq,ScaFreq,RitA,iRit1,iRit1L,RitS,RitMedio,Scarto,IncrRit)
aRisultato(1) = k
aRisultato(2) = s
aRisultato(3) = Freq
aRisultato(4) = ScaFreq
aRisultato(5) = RitA
aRisultato(6) = iRit1
aRisultato(7)= iRit1L
aRisultato(8)= RitS
aRisultato(9) = RitMedio
aRisultato(10) = RitS - RitA
aRisultato(11) = IncrRit
End Sub
Function ImpostaParametri(nClasse,nSorte,Form,FormStud,aStudio,nRuote,aRu)
Dim bRet,i
nClasse = ScegliClasse ' sviluppo in ambi
If nClasse > 0 Then
nSorte = SelEsito
If nSorte > 0 Then
Do While nClasse < nSorte
MsgBox "hai inserito Un Valore errato riscrivi ": nSorte = CInt(SelEsito)
If nSorte = - 1 Then Exit Do
Loop
Form = GetFormazione
If Form > 0 Then
FormStud = GetFormazioneStudio(Form)
If FormStud >= 0 Then
Call GetArrayStudio(Form,FormStud,aStudio)
If IsArray(aStudio) Then
nRuote = ScegliRuote(aRu)
For i = 1 To UBound(aRu)
Do While aRu(i) > 10
If aRu(i) > 10 Then
MsgBox"Non Puoi Inserire La Voce Tutte o Nazionale ai Fini Statistici"
nRuote = ScegliRuote(aRu)
Else
Exit Do
End If
Loop
Next
If IsArray(aRu) Then
bRet = True
End If
End If
End If
End If
End If
End If
ImpostaParametri = bRet
End Function
Function ScegliClasse
Dim aVoci,bRet
aVoci = Array("","Estratti","Ambi","Terzina","Quartina","Cinquina","Sestina",_
"Settina","Ottina","Novina","Decina")
bRet = ScegliOpzioneMenu(aVoci,1,"Seleziona Classe di Sviluppo")
ScegliClasse = bRet
End Function
Function ScriviClasse(sceCla)
Dim aVoci,bRet
aVoci = Array("","Estratti","Ambi","Terzina","Quartina","Cinquina","Sestina",_
"Settina","Ottina","Novina","Decina")
For bRet = 1 To UBound(aVoci)
aVoci(bRet) = aVoci(bRet)
Next
ScriviClasse = aVoci(sceCla)
End Function
Function SelEsito
Dim bRet
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
bRet = ScegliOpzioneMenu(aVoci,1," Analesi per Sorte di : ")
SelEsito = bRet
End Function
Function ScriviEsito(Ind)
Dim bRet,i
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
For i = 1 To UBound(aVoci)
aVoci(i) = aVoci(i)
Next
ScriviEsito = aVoci(Ind)
End Function
Function ContaEstrazioni(Ini,Fin,aRU(),nRuote)
Dim Conta,es,i
For es = Ini To Fin
For i = 1 To UBound(aRU)
If SommaEstratti(es,aRU(i)) >= 15 Then Conta = Conta + 1
Next
Next
ContaEstrazioni = Round(Dividi(Conta,nRuote),0)
End Function
Function GetFormazione
Dim aVoci,bRet
aVoci = Array("","Decina Naturale","Decina Cabalistica","Figura","ControFigura","Cadenza")
bRet = ScegliOpzioneMenu(aVoci,1,"SelezionaFormazione")
GetFormazione = bRet
End Function
Function GetFormazioneStudio(IndForm)
ReDim aNum(9)
Dim K,m
Dim bRet
For K = LBound(aNum) To UBound(aNum) - 1
If IndForm = 1 Then aNum(K) = "DecinaNaturale." & K
Next
For K = 1 To UBound(aNum)
If IndForm = 2 Then
aNum(K) = "DecinaCabalistica." & K
ElseIf IndForm = 3 Then
aNum(K) = "Figura." & K
ElseIf IndForm = 4 Then
aNum(K) = "ControFigura." & K
End If
Next
For K = LBound(aNum) To UBound(aNum)
If IndForm = 5 Then aNum(K) = "Cadenza." & K
Next
bRet = ScegliOpzioneMenu(aNum,1,"SelezionaInformazione")
GetFormazioneStudio = bRet
End Function
Function GetArrayStudio(IndFor,IndStudio,aArray)
Dim k,m
Dim aNumeri(90)
m = 1
For k = 1 To 90
If IndFor = 1 And DecinaNaturale(k) = IndStudio Then
m = m + 1
ReDim Preserve aArray(m)
aArray(m) = k
ElseIf IndFor = 2 And DecinaCabalistica(k) = IndStudio Then
m = m + 1
ReDim Preserve aArray(m)
aArray(m) = k
ElseIf IndFor = 3 And Figura(k) = IndStudio Then
m = m + 1
ReDim Preserve aArray(m)
aArray(m) = k
ElseIf IndFor = 4 And ControFigura(k) = IndStudio Then
m = m + 1
ReDim Preserve aArray(m)
aArray(m) = k
ElseIf IndFor = 5 And Cadenza(k) = IndStudio Then
m = m + 1
ReDim Preserve aArray(m)
aArray(m) = k
End If
Next
End Function
Function ScriviArrayStudio(IndFor,IndStudio)
Dim bRet
If IndFor = 1 Then
bRet = "Decina Naturale: " & IndStudio
ElseIf IndFor = 2 Then
bRet = "Decina Cabalistica: " & IndStudio
ElseIf IndFor = 3 Then
bRet = "Figura: " & IndStudio
ElseIf IndFor = 4 Then
bRet = "Controfigura: " & IndStudio
ElseIf IndFor = 5 Then
bRet = "Cadenza: " & IndStudio
End If
ScriviArrayStudio = bRet
End Function
Function RitardoMedio(aRitardi())
Dim k
Dim nElementi
Dim nMedia
nElementi=0
nMedia=0
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
