Option Explicit
Sub Main
Dim idEstr,Ruota
Dim Inizio,Fine
Dim e,nLottrone
Dim nColpiMax
Dim bMostraDett
Inizio = EstrazioneIni
Fine = EstrazioneFin
nColpiMax = 12
nColpiMax = Int(InputBox("Entro quante estrazioni contigue considerare validi per la condizione i due elementi della tripla di cadenza usciti in successione ?",,nColpiMax))
If MsgBox("Mostrare i dettagli dei calcoli ?",vbQuestion + vbYesNo) = vbYes Then
bMostraDett = True
End If
ReDim aPresenzeEntroColpi(12,nColpiMax)
ReDim aCasiTot(12)
ReDim aCasiVinc(12)
If nColpiMax > 0 Then
For Ruota = 1 To 12
If Ruota <> 11 Then
Call Messaggio("Analisi ruota " & NomeRuota(Ruota))
For idEstr = Inizio To Fine - 1
For e = 1 To 5
ReDim aNumTripla(0)
ReDim abNumTripla(0)
nLottrone = Estratto(idEstr,Ruota,e)
Call GetTriplaCadenzaByNum(nLottrone,aNumTripla,abNumTripla)
Call AnalizzaTripla(nLottrone,abNumTripla,aNumTripla,idEstr,Ruota,aPresenzeEntroColpi,aCasiTot,aCasiVinc,nColpiMax,bMostraDett)
Next
If ScriptInterrotto Then Exit Sub
Next
End If
Call AvanzamentoElab(1,12,Ruota)
If ScriptInterrotto Then Exit Sub
Next
Call Riepilogo(aPresenzeEntroColpi,aCasiTot,aCasiVinc,nColpiMax,Inizio,Fine)
Else
MsgBox "Colpi massimi non validi"
End If
End Sub
Sub Riepilogo(aPresenzeEntroColpi,aCasiTot,aCasiVinc,nColpiMax,Inizio,Fine)
Dim k,r,nCol
ReDim aColSp(23)
ReDim aV(23)
ReDim aColori(23)
Dim nColoreA,nColoreB,nColore
' preimposta var
nColoreA = RGB(255,198,255)
nColoreB = RGB(204,204,255)
nColore = nColoreA
nCol = 0
aColori(1) = vbYellow
For k = 1 To 12
If k <> 11 Then
nCol = nCol + 2
aColori(nCol) = nColore
aColori(nCol + 1) = nColore
If nColore = nColoreA Then
nColore = nColoreB
Else
nColore = nColoreA
End If
End If
Next
For k = 1 To UBound(aV)
aV(k) = ""
aColSp(k) = 0
Next
' scrive intestazione output
Call Scrivi("Analisi delle uscite del terzo elemento delle triple di cadenza dopo l'uscita dei primi due in due estrazioni entro colpi " & nColpiMax,True)
' scrivo intestazione tabella
aColSp(1) = 23
aV(1) = GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Call InitTabella(aV,vbBlue,,,vbWhite,,aColSp)
' seconda riga intestazione
aColSp(1) = 1
ReDim aV(23)
nCol = 0
For r = 1 To 12
If r <> 11 Then
nCol = nCol + 2
aV(nCol) = NomeRuota(r)
aColSp(nCol) = 2
End If
Next
Call AddRigaTabella(aV,vbMagenta,,,,,aColSp)
Call SetColoreCella(1,vbYellow)
' terza riga intestazione
ReDim aV(23)
aV(1) = "Colpi"
For k = 2 To 23
If k Mod 2 = 0 Then
aV(k) = "Q."
Else
aV(k) = "%"
End If
Next
Call AddRigaTabella(aV,vbMagenta)
Call SetColoreCella(1,vbYellow)
' scrivo i valori per le 11 ruote per i colpi previsti
For k = 1 To nColpiMax
ReDim aV(23)
aV(1) = k
nCol = 0
For r = 1 To 12
If r <> 11 Then
nCol = nCol + 2
aV(nCol) = aPresenzeEntroColpi(r,k)
aV(nCol + 1) = Round(ProporzioneX(aPresenzeEntroColpi(r,k),aCasiTot(r),100),3)
End If
Next
Call AddRigaTabella(aV,aColori)
Next
ReDim aV(23)
aV(1) = "Altro"
nCol = 0
For r = 1 To 12
If r <> 11 Then
nCol = nCol + 2
aV(nCol) = aPresenzeEntroColpi(r,0)
aV(nCol + 1) = Round(ProporzioneX(aPresenzeEntroColpi(r,0),aCasiTot(r),100),3)
End If
Next
Call AddRigaTabella(aV,aColori)
' scrivo la riga con la quantita dei casi trovati
ReDim aV(23)
aV(1) = "Casi totali"
nCol = 0
For r = 1 To 12
If r <> 11 Then
nCol = nCol + 2
aV(nCol) = aCasiTot(r)
End If
Next
Call AddRigaTabella(aV,aColori,,,,,aColSp)
' scrivo la riga con la percentuale dei casi positivi trovati
ReDim aV(23)
aV(1) = "Casi positivi"
nCol = 0
For r = 1 To 12
If r <> 11 Then
nCol = nCol + 2
aV(nCol) = aCasiVinc(r)
aV(nCol + 1) = Round(ProporzioneX(aCasiVinc(r),aCasiTot(r),100),3)
End If
Next
Call AddRigaTabella(aV,aColori)
Call SetTableWidth("80%")
Call CreaTabella
ReDim aV(4)
aV(1) = "Ruota"
aV(2) = "Casi Tot"
aV(3) = "Positivi"
aV(4) = "Percentuale"
Call InitTabella(aV,vbBlue,,,vbWhite)
For r = 1 To 12
nCol = 0
If r <> 11 Then
nCol = nCol + 1
aV(1) = NomeRuota(r)
aV(2) = aCasiTot(r)
aV(3) = aCasiVinc(r)
aV(4) = Round(ProporzioneX(aCasiVinc(r),aCasiTot(r),100),3)
Call AddRigaTabella(aV)
End If
Next
Call CreaTabella(4)
End Sub
Function GetTriplaCadenzaByNum(n,aRetNum,aBRetNum)
Dim k
ReDim aRetNum(3)
ReDim aBRetNum(90)
If n >= 1 And n <= 30 Then
aRetNum(1) = n
aRetNum(2) = n + 30
aRetNum(3) = n + 60
ElseIf n >= 31 And n <= 60 Then
aRetNum(1) = n - 30
aRetNum(2) = n
aRetNum(3) = n + 30
ElseIf n >= 61 And n <= 90 Then
aRetNum(1) = n - 60
aRetNum(2) = n - 30
aRetNum(3) = n
End If
For k = 1 To 3
aBRetNum(aRetNum(k)) = True
Next
End Function
Sub AnalizzaTripla(nLottrone,abNumTripla,aNumTripla,idEstr,Ruota,aPresenzeEntroColpi,aCasiTot,aCasiVinc,nColpiMax,bMostraDettagli)
Dim e,ee,n,idEstrTmp,idEstrRic,nColpo,bFound,nSecondoEl,nTerzoEl
nColpo = 0
bFound = False
abNumTripla(nLottrone) = False
For idEstrRic = idEstr + 1 To idEstr + nColpiMax
For e = 1 To 5
nSecondoEl = Estratto(idEstrRic,Ruota,e)
If abNumTripla(nSecondoEl) Then
abNumTripla(nSecondoEl) = False
aCasiTot(Ruota) = aCasiTot(Ruota) + 1
For idEstrTmp = idEstrRic + 1 To idEstrRic + nColpiMax
nColpo = nColpo + 1
For ee = 1 To 5
n = Estratto(idEstrTmp,Ruota,ee)
If abNumTripla(n) Then
bFound = True
Exit For
End If
Next
If bFound Then Exit For
Next
If bFound Then
aCasiVinc(Ruota) = aCasiVinc(Ruota) + 1
aPresenzeEntroColpi(Ruota,nColpo) = aPresenzeEntroColpi(Ruota,nColpo) + 1
Else
aPresenzeEntroColpi(Ruota,0) = aPresenzeEntroColpi(Ruota,0) + 1
End If
If bMostraDettagli Then
Call Scrivi("Numeri della tripla di cadenza : " & StringaNumeri(aNumTripla) & " su " & NomeRuota(Ruota),True)
Call Scrivi(nLottrone & " uscito in estrazione " & GetInfoEstrazione(idEstr) & " --> " & GetRigaEstrazione(idEstr,Ruota))
Call Scrivi(nSecondoEl & " uscito in estrazione " & GetInfoEstrazione(idEstrRic) & " --> " & GetRigaEstrazione(idEstrRic,Ruota) & " dopo " &(idEstrRic - idEstr) & " estraziioni")
If bFound Then
Call Scrivi("Elemento mancante " & ArrayBToString(abNumTripla) & " Uscito al colpo : " & nColpo & " " & GetInfoEstrazione(idEstrTmp) & " --> " & GetRigaEstrazione(idEstrTmp,Ruota),,,,RGB(50,137,65))
Else
Call Scrivi("Elemento mancante " & ArrayBToString(abNumTripla) & " Non uscito entro i colpi previsti",,,,vbRed)
End If
Call Scrivi
End If
Exit Sub
End If
Next
Next
End Sub
Function GetRigaEstrazione(idEstr,ruota)
ReDim aN(0)
Call GetArrayNumeriRuota(idEstr,ruota,aN)
GetRigaEstrazione = StringaNumeri(aN)
End Function
Function ArrayBToString(abNum)
Dim k
Dim s
s = ""
For k = LBound(abNum) To UBound(abNum)
If abNum(k) Then
s = s & Format2(k) & "."
End If
Next
If s <> "" Then
ArrayBToString = Left(s,Len(s) - 1)
Else
ArrayBToString = ""
End If
End Function
