Option Explicit
Sub Main
'Script Frequenze_Combinazioni nei cicli su richiesta :-)
' controllare evenuali bugs
'controllare le formule che ho utilizzato per calcolare l' inizio e fine ricerca se sono corrette potrei aver sbagliato,la testa fuma
'Se i riscontri statisci dovessero essere errati comunicarli per correggere il problema se possibile
Dim nCicli,LenCicli,Inizio,Fine
Dim idEstr,idesito,idComb
Dim I,j
Dim nColTot,sNum
Dim iPresenze,iNegativi
ReDim aNum(0),aRuote(0)
ReDim aCicli(0),aTitoli(0)
If ImpostaParametri(LenCicli,nCicli,aRuote,aNum,idComb,idesito,Inizio,Fine) = False Then
MsgBox "I Parametri inseriti sono ERRATI",vbCritical
Exit Sub
End If
Call Get_aTitoli(nCicli,LenCicli,Inizio,Fine,aCicli,aTitoli)
Call InitTabella(aTitoli)
Call GetIntestazione(nCicli,LenCicli,aNum,idComb,idesito,aRuote)
I = 0
nColTot = InitSviluppoIntegrale(aNum,idComb)
Do While GetCombSviluppo(aNum)
I = I + 1
Messaggio "Elaborazione in corso id sviluppo: " & I
AvanzamentoElab 1,nColTot,I
If ScriptInterrotto Then Exit Do
sNum = StringaNumeri(aNum,,True)
ReDim aRis(2)
Call alimentaArrayTab(aRis,I,sNum,nCicli,LenCicli,Inizio,Fine,aCicli,aNum,aRuote,idesito)
Call AddRigaTabella(aRis)
For j = 1 To nCicli
If aRis(j + 2) = 0 Then Call SetColoreCella(CInt(j + 2),RGB(255,243,204)) : Else Call SetColoreCella(CInt(j + 2),RGB(222,251,170))
Next
Loop
Call CreaTabellaOrdinabile
End Sub
Sub Get_aTitoli(nCicli,LenCicli,Inizio,Fine,aCicli,aTitoli)
Dim idEstr,m,i,j,n,k
ReDim aTitoli(2)
ReDim aCicli(0)
m = 0
For idEstr = Inizio To Fine Step LenCicli
m = m + 1
ReDim Preserve aCicli(m)
aCicli(m) = CStr(idEstr) & " - " & CStr(idEstr +(LenCicli - 1))
Next
aTitoli(1) = "IdComb"
aTitoli(2) = "aNumeri"
n = 2
For j = 1 To UBound(aCicli)
n = n + 1
ReDim Preserve aTitoli(n)
aTitoli(n) = aCicli(j)
Next
ReDim Preserve aTitoli(n + 5)
aTitoli(n + 1) = "Frequenze"
aTitoli(n + 2) = "Presenze"
aTitoli(n + 3) = "Assenze"
aTitoli(n + 4) = " Ritardo "
aTitoli(n + 5) = " RitMax "
End Sub
Sub alimentaArrayTab(aRis,idComb,sNum,nCicli,LenCicli,Inizio,Fine,aCicli,aNum,aRuote,idEsito)
Dim n,idEstr,Inegativi,iPresenze,iFrequenze
aRis(1) = idComb
aRis(2) = sNum
n = 2
Inegativi = 0
iPresenze = 0
For idEstr = Inizio To Fine Step LenCicli
n = n + 1
ReDim Preserve aRis(n)
ReDim Preserve rit(1)
ReDim Preserve sto(1)
'ReDim Preserve RRel(1)
aRis(n) = SerieFreqTurbo(idEstr,idEstr +(LenCicli - 1),aNum,aRuote,idEsito)
rit(1) = SerieRitardoTurbo(EstrazioneIni,EstrazioneFin,aNum,aRuote,idEsito)
sto(1) = SerieStoricoTurbo(EstrazioneFin - 180,EstrazioneFin,aNum,aRuote,idEsito)
'RRel(1) = RitPos(sNum,1,idEstr)
If CLng(aRis(n)) = 0 Then
Inegativi = Inegativi + 1
Else
iFrequenze = iFrequenze + CLng(aRis(n))
iPresenze = iPresenze + 1
End If
Next
ReDim Preserve aRis(n + 5)
aRis(n + 1) = iFrequenze
aRis(n + 2) = iPresenze
aRis(n + 3) = Inegativi
aRis(n + 4) = rit(1)
aRis(n + 5) = sto(1)
End Sub
Sub GetIntestazione(nCicli,LenCicli,aNum,idComb,idEsito,aRuote)
Call Scrivi("Il gioco è vietato ai minori di anni 18,e, può comportare grave dipendenza Patologica")
Call Scrivi("Verificare sempre anche da altre fonti che l'output restituito dallo script risulti corretto")
Call Scrivi
Call Scrivi
Call Scrivi("Inizio Analisi :")
Call Scrivi("Numero Cicli analizzati : " & nCicli)
Call Scrivi("Lunghezza Cicli : " & LenCicli)
Call Scrivi("Array Numeri : " & StringaNumeri(aNum,,True))
Call Scrivi("Sviluppoc Comb. : " & NomeCombinazione(idComb))
Call Scrivi("Sorte Analizzata : " & NomeEsito(idEsito))
Call Scrivi("Ruote analizzate : " & StringaRuote(aRuote,True))
Call Scrivi
End Sub
Function ImpostaParametri(LenCicli,nCicli,aRuote,aNum,idComb,idEsito,Inizio,Fine)
Dim bRet
LenCicli = CInt(InputBox("Inserire la lunghezza dei cicli ",,18))
If LenCicli > 0 Then
nCicli = CInt(InputBox("Inserire il numero dei cicli da " & LenCicli,,10))
If nCicli > 0 Then
ScegliRuote(aRuote)
If UBound(aRuote) > 0 Then
ScegliNumeri(aNum)
If UBound(aNum) > 0 Then
idComb = ScegliCombinazione
If UBound(aNum) >= idComb And idComb > 0 Then
idEsito = SelEsito
If idComb >= idEsito And idEsito > 0 Then
Inizio =(EstrazioneFin -(nCicli * LenCicli)) + 1
If Inizio >= 1 Then
Fine = EstrazioneFin -(LenCicli - 1)
If Fine <= EstrazioneFin Then
bRet = True
End If
End If
End If
End If
End If
End If
End If
End If
ImpostaParametri = bRet
End Function
Function NomeCombinazione(a)
Dim aVoci
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine","Sestine","Settine","Ottine","Novine","Decine","Undicine","Dodicine","Tredicine","Quattordicine","Quindicine")
NomeCombinazione = aVoci(a)
End Function
Function ScegliCombinazione
Dim ret
Dim aVoci
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine","Sestine","Settine","Ottine","Novine","Decine","Undicine","Dodicine","Tredicine","Quattordicine","Quindicine")
ret = ScegliOpzioneMenu(aVoci,1," Combina i numeri In :")
ScegliCombinazione = ret
End Function
Function SelEsito
Dim ret
Dim aVoci
aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
ret = ScegliOpzioneMenu(aVoci,1," Analesi per Sorte di : ")
SelEsito = ret
End Function
Function NomeEsito(a)
Dim aVoci
aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
NomeEsito = aVoci(a)
End Function
