Option Explicit
Dim cIdRit,cIdRitMax,cIdFreq,cMaxRigo
Sub Main
Dim Ini,Fin
Dim r,k,e,n,nRit,nSfald,bMostraSoloRigheConNumeri
Dim aBRuote
ReDim aRt(1)
ReDim aNumRuota(5)
Dim aBNumRuota
Dim nTipoCalcFrq
Dim T
If MsgBox("Mostrare solo le righe alla cui posizione nel tab analitico sono effettivamente presenti dei numeri ?",vbQuestion + vbYesNo) = vbYes Then
bMostraSoloRigheConNumeri = True
End If
nTipoCalcFrq = scegliTipoCalcFrq
Call ScegliRuote(Nothing,aBRuote)
cMaxRigo = 250
cIdRit = 0
cIdRitMax = 1
cIdFreq = 2
T = Timer
ReDim aRitPerRigo(cMaxRigo,12,2)
Ini = EstrazioneIni
Fin = EstrazioneFin
For r = 1 To 12
If r <> 11 Then
If aBRuote(r) Then
ReDim aN(90)
aRt(1) = r
Call GetRitardoEstratti(aRt,Ini-1,aN)
For k = Ini To Fin
Call GetArrayNumeriRuota(k,r,aNumRuota)
ReDim aBRit(cMaxRigo)
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
If nTipoCalcFrq =0 Then
aRitPerRigo(aN(aNumRuota(e)),r,cIdRit) = 0
aRitPerRigo(aN(aNumRuota(e)),r,cIdFreq) = aRitPerRigo(aN(aNumRuota(e)),r,cIdFreq) + 1
Else
If Not aBRit(aN(aNumRuota(e))) Then
aBRit(aN(aNumRuota(e))) = True
aRitPerRigo(aN(aNumRuota(e)),r,cIdRit) = 0
aRitPerRigo(aN(aNumRuota(e)),r,cIdFreq) = aRitPerRigo(aN(aNumRuota(e)),r,cIdFreq) + 1
End If
End If
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(2)
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 =(P*Estrazioni*(Att - Pre))
End Function
Function scegliTipoCalcFrq
Dim aV
aV = Array ("Incrementa per ogni caduta" ,"Incrementa allo sfaldamento del rigo")
scegliTipoCalcFrq = ScegliOpzioneMenu (aV , 0)
End Function
Cordiali saluti.
