Option Explicit
Dim cIdRit,cIdRitMax,cIdFreq,cMaxRigo
Sub Main
Dim Ini,Fin
Dim r,k,e,n,nRit,nSfald,bMostraSoloRigheConNumeri
Dim aBRuote(12)
ReDim aRt(1)
ReDim aNumRuota(5)
Dim aBNumRuota
Dim T
'If MsgBox("Mostrare solo le righe alla cui posizione nel tab analitico sono effettivamente presenti dei numeri ?",vbQuestion + vbYesNo) = vbYes Then
bMostraSoloRigheConNumeri = False
'End If
'Call ScegliRuote (Nothing,aBRuote)
aBRuote(3) = True
cMaxRigo = 250
cIdRit = 0
cIdRitMax = 1
cIdFreq = 2
T = Timer
ReDim aRitPerRigo(cMaxRigo,12,2)
Ini = 3950 'EstrazioneIni
Fin = 3954 'EstrazioneFin
For r = 1 To 12
If r <> 11 Then
If aBRuote(r) Then
ReDim aN(90)
aRt(1) = r
Call GetRitardoEstratti(aRt,Ini,aN)
For k = Ini + 1 To Fin
Call GetArrayNumeriRuota(k,r,aNumRuota)
If aNumRuota(1) > 0 Then
For nRit = 0 To cMaxRigo
aRitPerRigo(nRit,r,cIdRit) = aRitPerRigo(nRit,r,cIdRit) + 1
Next
For e = 1 To 5
nRit =(aRitPerRigo(aN(aNumRuota(e)),r,cIdRit) - 1)
If nRit > aRitPerRigo(aN(aNumRuota(e)),r,cIdRitMax) Then
aRitPerRigo(aN(aNumRuota(e)),r,cIdRitMax) = nRit
End If
aRitPerRigo(aN(aNumRuota(e)),r,cIdRit) = 0
aRitPerRigo(aN(aNumRuota(e)),r,cIdFreq) = aRitPerRigo(aN(aNumRuota(e)),r,cIdFreq) + 1
Next
aBNumRuota = ArrayNumeriToBool(aNumRuota)
For n = 1 To 90
If aBNumRuota(n) Then
aN(n) = 0
Else
aN(n) = aN(n) + 1
End If
Next
End If
Next
End If
End If
Call AvanzamentoElab(1,12,r)
Next
Scrivi "Tempo Elab : " & Timer - T
T = Timer
Call GestioneOutput(Ini,Fin,bMostraSoloRigheConNumeri,aBRuote,aRitPerRigo)
Scrivi "Tempo crea tabella : " & Timer - T
End Sub
Sub GestioneOutput(Ini,Fin,bMostraSoloRigheConNumeri,abRuote,aRitPerRigo)
Dim r,k,e,n,sNum,bValida,qNum,nFatte,qRuote
nFatte = Fin -(Ini)
ReDim aV(18)
aV(1) = "Rigo"
aV(2) = "Ritardo"
aV(3) = "RitardoMax"
aV(4) = "Frequenza"
aV(5) = "Ru"
aV(6) = "Numeri"
aV(7) = "IC"
aV(8) = "QR"
aV(9) = "QT"
aV(10) = "QR-QT"
aV(11) = "A"
aV(12) = "QRRu"
aV(13) = "QTRu"
aV(14) = "QRRu -QTRu"
aV(15) = "ARu"
aV(16) = "PT"
aV(17) = "Freq-PT"
aV(18) = "A"
ReDim aPresTotPerRigo(cMaxRigo)
Call GeneraAnaliticoTurbo(Fin)
For r = 1 To 12
If abRuote(r) Then qRuote = qRuote + 1
Next
For k = 0 To cMaxRigo
For r = 1 To 12
If abRuote(r) Then
If r <> 11 Then
For e = 1 To 5
n = TabelloneAnaliticoTurbo(k,r,e)
If n > 0 Then
aPresTotPerRigo(k) = aPresTotPerRigo(k) + 1
End If
Next
End If
End If
Next
Next
Messaggio "Creazione tabella"
DoEventsEx
Call InitTabella(aV)
For r = 1 To 12
If r <> 11 And abRuote(r) Then
For k = 0 To cMaxRigo
aV(1) = k
aV(2) = aRitPerRigo(k,r,cIdRit)
aV(3) = aRitPerRigo(k,r,cIdRitMax)
aV(4) = aRitPerRigo(k,r,cIdFreq)
aV(5) = NomeRuota(r)
sNum = ""
qNum = 0
For e = 1 To 5
n = TabelloneAnaliticoTurbo(k,r,e)
If n > 0 Then
qNum = qNum + 1
sNum = sNum & n & "."
End If
Next
sNum = RimuoviLastChr(sNum,".")
bValida = False
If bMostraSoloRigheConNumeri Then
If sNum <> "" Then bValida = True
Else
bValida = True
End If
If bValida Then
aV(6) = sNum
aV(7) = Round(Dividi(aRitPerRigo(k,r,cIdRit),Dividi(nFatte,aRitPerRigo(k,r,cIdFreq))),3)
aV(8) = qNum
aV(9) = Round(GetPresTeo(k ,1),3)
aV(10) = Round (qNum -aV(9),3)
aV(11) = Round(Dividi(qNum,(qNum + CDbl(aV(9)))),3)
aV(12) = aPresTotPerRigo(k)
aV(13) = Round(GetPresTeo(k , qRuote),3)
aV(14) = Round (aPresTotPerRigo(k)-aV(13),3)
aV(15) = Round(Dividi(aPresTotPerRigo(k),(aPresTotPerRigo(k) + CDbl(aV(13)))),3)
aV(16) = Round(PresenzeTeoriche ( k+1 ,nFatte ,1),3)
aV(17) = Round( aRitPerRigo(k,r,cIdFreq) - aV(16) ,3)
aV(18) = Round(Dividi(aRitPerRigo(k,r,cIdFreq),(aRitPerRigo(k,r,cIdFreq) + CDbl(aV(16)))),3)
Call AddRigaTabella(aV)
End If
Next
End If
Next
Call Scrivi("Inizio : " & GetInfoEstrazione(Ini))
Call Scrivi("Fine : " & GetInfoEstrazione(Fin))
Call SetTableWidth("100%")
Call CreaTabellaOrdinabile(1,1)
End Sub
Function GetPresTeo(Rit,qRuote)
GetPresTeo = 5* qRuote *(17/18)^Rit
End Function
Function PresenzeTeoriche(Ritardo,Estrazioni ,Ruote)
' funzione by Joe
Dim P,Q
Dim Att,Pre
P = 5 * Ruote ' Estratti
Q = 17/18 ' Probabilità Contraria
Att = 1 - Q^Ritardo 'Attuale
Pre = 1 - Q^(Ritardo - 1)'Precedente
PresenzeTeoriche = Round(P*Estrazioni*(Att - Pre))
End Function
