Option Explicit
Sub Main
'Script Frequenze_Combinazioni nei cicli su richiesta di lotto_tom75 :-)
' 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,nColTot,sNum
Dim iPresenze,iNegativi
ReDim aNum(0),aRuote(0),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,RGB(239,239,239),,,RGB(128,0,0))
i = 0
nColTot = InitSviluppoIntegrale(aNum,idComb)
Call GetIntestazione(nCicli,LenCicli,aNum,idComb,idesito,aRuote,nColTot)
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)
If aRis(i)>= 1000 Then Call AddRigaTabella(aRis)
Call ColoraTabella(nCicli,aRis)
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 + 9)
aTitoli(n + 1) = "Freq.Cicli"
aTitoli(n + 2) = "Pres.Cicli"
aTitoli(n + 3) = "Asse.Cicli"
aTitoli(n + 4) = "Rit.Cro. "
aTitoli(n + 5) = "Rit.Sto. "
aTitoli(n + 6) = "Sto.-Cro."
aTitoli(n + 7) = "Cro./Sto."
aTitoli(n + 8) = "incRit.Sto."
aTitoli(n + 9) = "Fre.Global"
End Sub
Sub alimentaArrayTab(aRis,idComb,sNum,nCicli,LenCicli,Inizio,Fine,aCicli,aNum,aRuote,idEsito)
Dim n,idEstr,Inegativi,iPresenze,iFrequenze
Dim iRit,iRitMax,iIncr,iFreq
aRis(1) = idComb
aRis(2) = sNum
n = 2
Inegativi = 0
iPresenze = 0
iFrequenze = 0
For idEstr = Inizio To Fine Step LenCicli
n = n + 1
ReDim Preserve aRis(n)
ReDim Preserve rit(1)
aRis(n) = SerieFreqTurbo(idEstr,idEstr +(LenCicli - 1),aNum,aRuote,idEsito)
Call StatisticaFormazioneTurbo(aNum,aRuote,idEsito,iRit,iRitMax,iIncr,iFreq,EstrazioneIni,EstrazioneFin)
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 + 9)
aRis(n + 1) = iFrequenze
aRis(n + 2) = iPresenze
aRis(n + 3) = Inegativi
aRis(n + 4) = iRit
aRis(n + 5) = iRitMax
aRis(n + 6) = iRitMax - iRit
aRis(n + 7) = Round(Dividi(iRit,iRitMax),2)
aRis(n + 8) = iIncr
aRis(n + 9) = iFreq
End Sub
Sub GetIntestazione(nCicli,LenCicli,aNum,idComb,idEsito,aRuote,nColTot)
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. : " & nColTot & " " & 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
Sub ColoraTabella(nCicli,aRis)
Dim i,j,k
i = 3
j = nCicli
For k = i To nCicli + 2
If aRis(k) = 0 Then Call SetColoreCella(CInt(k),RGB(255,243,204)) : Else Call SetColoreCella(CInt(k),RGB(222,251,170))
Next
i = k
j = i + 2
For k = i To j : Call SetColoreCella(CInt(k),RGB(255,223,255)) : Next
i = k
For k = i To UBound(aRis) : Call SetColoreCella(CInt(k),RGB(232,222,248)) : Next
End Sub
forse short? 32.767? Forse dico una cavolata. Se quali colonne vuoi filtrare ti metto il limite oppure se non ti va ti dico come fare
. Dovrei analizzare su TUTTE (unite) per 10 cicli ciascuno di 18 estrazioni in 10ine x T partendo da un numero di elementi semi-casuale... di 20. Se vuoi puoi provare benissimo anche con 1.2.3.4.5.6.7.8.9.10.11.12.13.14.15.16.17.18.19.20 per non stare a perderci troppo tempo 
Ciao grandissimo! 
