Option Explicit
' Controllare se lo script Fa quanto richiesto
' controllare se i dati riportati sono corretti
' Salvo errori ed omissis
Sub Main
Dim aRuSpia,nRuSpia
nRuSpia = Specchietto(aRuSpia)
If nRuSpia = False Then
Call MsgBox("Hai inserito una o piu ruote non valide",4,"Errore Ruota")
Exit Sub
End If
Dim Ini,Fin
Call ScegliRange(Ini,Fin,3950,EstrazioneFin)
If Not isIdEstrValido(Ini) Then Call MsgBox("Range estrazioni non valido",vbError,"Messaggio di errore"): Exit Sub
Dim nClp:nClp = CInt(InputBox("Scegli numero compreso tra 1 e 30","Seleziona Colpi di gioco",18))
Dim IniG,FinG
Dim IdEstr,R,p,pp,ps
Dim E1p,E1,Eps,Es,v1,v2
Dim nCasiTro,nCasiSin,nCasiDes
Dim aAmbD,aAmbS,aTern1S,aTern2S,aTern1D,aTern2D
Dim aRuVer(1),aRt(1)
Dim FrzAsinRuota,FrezAsinTutte,FrzAsinRuotaTotale,FrezAsinTutteTotale
Dim FrzADesRuota,FrzAdesTutte,FrzADesRuotaTotale,FrzAdesTutteTotale
Dim FrzTern1SinRuota,FrzTern1SinTutte,FrzTern1SinRuotaTotale,FrzTern1SinTutteTotale
Dim FrzTern2SinRuota,FrzTern2SinTutte,FrzTern2SinRuotaTotale,FrzTern2SinTutteTotale
Dim FrzTern1DesRuota,FrzTern1DesTutte,FrzTern1DesRuotaTotale,FrzTern1DesTutteTotale
Dim FrzTern2DesRuota,FrzTern2DesTutte,FrzTern2DesRuotaTotale,FrzTern2DesTutteTotale
Dim PresFormAmboS_Ru,PresFormAmboD_Ru,PresFormAmboS_TT,PresFormAmboD_TT
Dim PresFormTerS_Ru,PresFormTerD_Ru,PresFormTerS_TT,PresFormTerD_TT
Dim sSep:sSep = " | "
Dim LineaStitSup:LineaStitSup = " |_________ ________________ ____________________________|__________________ ______ _____________ ____________ ___________ "
Dim LineaStitSup1:LineaStitSup1 = " | | | | | | | | Ambo |"
Dim sTit:sTit = " | nCaso | Ruota | Info Estrazione | Estrazione | nRpt | Laterali | Formazioni |RSpia|Tutte|"
Dim LineasTit:LineasTit = " |_________|________________|____________________________|__________________|______|_____________|____________|_____|_____|"
aRt(1) = 11
nCasiTro = 0
nCasiSin = 0
nCasiDes = 0
Call SetColorSezione(RGB(0,0,0))
For IdEstr = Ini To Fin
For R = 1 To UBound(aRuSpia)
aRuVer(1) = aRuSpia(R)
If Estratto(IdEstr - 1,aRuVer(1),1) Then
For p = 1 To 5
E1p = Estratto(IdEstr - 1,aRuVer(1),p)
E1 = Estratto(IdEstr,aRuVer(1),p)
If E1p = E1 Then
IniG = IdEstr + 1
FinG = IniG + nClp
If FinG>Fin Then FinG=Fin
Dim ClpG :ClpG = Fin - IdEstr
If ClpG > nClp Then
Scrivi " _____________________________________________________",,,,vbRed
Scrivi " |-",,0,,vbCyan
Scrivi FormatSpace(" Verifica Metodo Terminata",53),,0,vbRed
Scrivi "-|",,,,vbCyan
Else
Scrivi " _____________________________________________________",,,,vbGreen
Scrivi " |-",,0,,vbCyan
Scrivi FormatSpace(" Metodo In corso [estrazioni verificate : "&ClpG & "]",53),,0,vbGreen
Scrivi "-|",,,,vbCyan
End If
Scrivi LineaStitSup,,,,vbCyan
Scrivi LineaStitSup1,,,,vbCyan
Scrivi sTit,,,,vbCyan
Scrivi LineasTit,,,,vbCyan
nCasiTro = nCasiTro + 1
pp = FuoriX(p - 1,5) ' estratto a sinistra
ps = FuoriX(p + 1,5) ' estratto a destra
' prendo gli estratti a sinistra
Eps = Estratto(IdEstr - 1,aRuVer(1),pp) ' estratto a sinistra estrazione precedente
Es = Estratto(IdEstr,aRuVer(1),pp) ' estratto asinistra estrazionein corso
v1 = pari(Eps)
v2 = pari(Es)
If v1 = v2 Then
nCasiSin = nCasiSin + 1
Call Calcola(E1p,E1,Eps,Es,aAmbS,aTern1S,aTern2S)
' Calcolo la frequenza dell ambo a sinistra su ruota di verifica
FrzAsinRuota = SerieFreqTurbo(IniG,FinG,aAmbS,aRuVer,2)
'calcolo la frequenza totale dell ambo a sinistra su ruota
FrzAsinRuotaTotale = FrzAsinRuotaTotale + FrzAsinRuota
' calcolo la frequenza dell ambo a sinistra su tutte
FrezAsinTutte = SerieFreqTurbo(IniG,FinG,aAmbS,aRt,2)
' calcolo la frequenza totale dell ambo a sinistra su tutte
FrezAsinTutteTotale = FrezAsinTutteTotale + FrezAsinTutte
If FrzAsinRuota Then PresFormAmboS_Ru = PresFormAmboS_Ru + 1
If FrezAsinTutte Then PresFormAmboS_TT = PresFormAmboS_TT + 1
' Terzina 1
' -------------------------------------------------------------------
' calcolo la frequenza della prima terzina a sinistra a ruota
FrzTern1SinRuota = SerieFreqTurbo(IniG,FinG,aTern1S,aRuVer,2)
'calcolo la frequenza totale della prima terzina a sinistra a ruota
FrzTern1SinRuotaTotale = FrzTern1SinRuotaTotale + FrzTern1SinRuota
' Calcolo la frequenza della prima terzina a sinistra a tutte
FrzTern1SinTutte = SerieFreqTurbo(IniG,FinG,aTern1S,aRt,2)
'calcolo la frequenza totale della prima terzina a sinistra a tutte
FrzTern1SinTutteTotale = FrzTern1SinTutteTotale + FrzTern1SinTutte
' Terzina 2
' --------------------------------------------------------------------
' calcolo la frequenza della seconda terzina a sinistra a ruota
FrzTern2SinRuota = SerieFreqTurbo(IniG,FinG,aTern2S,aRuVer,2)
'calcolo la frequenza totale della prima terzina a sinistra a ruota
FrzTern2SinRuotaTotale = FrzTern2SinRuotaTotale + FrzTern2SinRuota
' Calcolo la frequenza della prima terzina a sinistra a tutte
FrzTern2SinTutte = SerieFreqTurbo(IniG,FinG,aTern2S,aRt,2)
'calcolo la frequenza totale della prima terzina a sinistra a tutte
FrzTern2SinTutteTotale = FrzTern2SinTutteTotale + FrzTern2SinTutte
' calcolo la presenza di una delle due terzine
If FrzTern1SinRuota Or FrzTern2SinRuota Then PresFormTerS_Ru = PresFormTerS_Ru + 1
If FrzTern1SinTutte Or FrzTern2SinTutte Then PresFormTerS_TT = PresFormTerS_TT + 1
'
Rem comincio a preparare l output
' Rigo 1
Scrivi " | " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & _
FormatSpace("",2) & sSep & FormatSpace("",9) & sSep & FormatSpace(StringaNumeri(aAmbS,,True),8) & sSep & _
FrzAsinRuota & sSep & FrezAsinTutte & sSep,,,,vbCyan
' rigo 2
Scrivi " | " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
Scrivi "S ( " & FormatSpace(Eps,2) & " ) ",1,0,,vbCyan
Scrivi sSep,,0,,vbCyan
Scrivi FormatSpace(StringaNumeri(aTern1S,,True),8),,0,,vbCyan
Scrivi sSep,,0,,vbCyan
Scrivi FrzTern1SinRuota,,0,,vbCyan
Scrivi sSep,,0,,vbCyan
Scrivi FrzTern1SinTutte,,0,,vbCyan
Scrivi sSep,,,,vbCyan
Rem rigo 3
Scrivi " | " & FormatSpace(nCasiTro,4,1) & sSep & FormatSpace(NomeRuota(aRuVer(1)),12) & sSep & GetInfoEstrazione(IdEstr - 1) & sSep & StringaEstratti(IdEstr - 1,aRuVer(1)) & sSep & FormatSpace(E1p,2) & sSep,,0,,vbCyan
Scrivi "S ( " & FormatSpace(Es,2) & " ) ",1,0,,vbCyan
Scrivi sSep,,0,,vbCyan
Scrivi FormatSpace(StringaNumeri(aTern2S,,True),8),,0,,vbCyan
Scrivi sSep,,0,,vbCyan
Scrivi FrzTern2SinRuota,,0,,vbCyan
Scrivi sSep,,0,,vbCyan
Scrivi FrzTern2SinTutte,,0,,vbCyan
Scrivi sSep,,,,vbCyan
Else
Rem Rigo 1
Scrivi " | " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & _
FormatSpace("",2) & sSep & FormatSpace("",9) & sSep,,0,,vbCyan
Scrivi String(8,"-"),,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,,,vbCyan
Rem Rigo 2
Scrivi " | " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
Scrivi "S ( " & FormatSpace(Eps,2) & " ) ",1,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi String(8,"-"),,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,,,vbCyan
Rem rigo 3
Scrivi " | " & FormatSpace(nCasiTro,4,1) & sSep & FormatSpace(NomeRuota(aRuVer(1)),12) & sSep & GetInfoEstrazione(IdEstr - 1) & sSep & StringaEstratti(IdEstr - 1,aRuVer(1)) & sSep & FormatSpace(E1p,2) & sSep,,0,,vbCyan
Scrivi "S ( " & FormatSpace(Es,2) & " ) ",1,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi String(8,"-"),,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,,,vbCyan
'
End If ' qui controllo se entrambi gli estratti sono pari o dispari
Eps = Estratto(IdEstr - 1,aRuVer(1),ps) ' estratto a Destra estrazione precedente
Es = Estratto(IdEstr,aRuVer(1),ps) ' estratto a Destra estrazionein corso
v1 = pari(Eps)
v2 = pari(Es)
If v1 = v2 Then
nCasiDes = nCasiDes + 1
Call Calcola(E1p,E1,Eps,Es,aAmbD,aTern1D,aTern2D)
' Calcolo la frequenza dell ambo a sinistra su ruota di verifica
FrzADesRuota = SerieFreqTurbo(IniG,FinG,aAmbD,aRuVer,2)
'calcolo la frequenza totale dell ambo a sinistra su ruota
FrzADesRuotaTotale = FrzADesRuotaTotale + FrzADesRuota
' calcolo la frequenza dell ambo a sinistra su tutte
FrzAdesTutte = SerieFreqTurbo(IniG,FinG,aAmbD,aRt,2)
' calcolo la frequenza totale dell ambo a sinistra su tutte
FrzAdesTutteTotale = FrzAdesTutteTotale + FrzAdesTutte
' Terzina 1
' -------------------------------------------------------------------
' calcolo la frequenza della prima terzina a sinistra a ruota
FrzTern1DesRuota = SerieFreqTurbo(IniG,FinG,aTern1D,aRuVer,2)
'calcolo la frequenza totale della prima terzina a sinistra a ruota
FrzTern1DesRuotaTotale = FrzTern1DesRuotaTotale + FrzTern1DesRuota
' Calcolo la frequenza della prima terzina a sinistra a tutte
FrzTern1DesTutte = SerieFreqTurbo(IniG,FinG,aTern1D,aRt,2)
'calcolo la frequenza totale della prima terzina a sinistra a tutte
FrzTern1DesTutteTotale = FrzTern1DesTutteTotale + FrzTern1DesTutte
' Terzina 2
' --------------------------------------------------------------------
' calcolo la frequenza della seconda terzina a sinistra a ruota
FrzTern2DesRuota = SerieFreqTurbo(IniG,FinG,aTern2D,aRuVer,2)
'calcolo la frequenza totale della prima terzina a sinistra a ruota
FrzTern2DesRuotaTotale = FrzTern2DesRuotaTotale + FrzTern2DesRuota
' Calcolo la frequenza della prima terzina a sinistra a tutte
FrzTern2DesTutte = SerieFreqTurbo(IniG,FinG,aTern2D,aRt,2)
'calcolo la frequenza totale della prima terzina a sinistra a tutte
FrzTern2DesTutteTotale = FrzTern2DesTutteTotale + FrzTern2DesTutte
'
'faccio i calcoli delle presenze e copertura casi
If FrzADesRuota Then PresFormAmboD_Ru = PresFormAmboD_Ru + 1
If FrzAdesTutte Then PresFormAmboD_TT = PresFormAmboD_TT + 1
If FrzTern1DesRuota Or FrzTern2DesRuota Then PresFormTerD_Ru = PresFormTerD_Ru + 1
If FrzTern1DesTutte Or FrzTern2DesTutte Then PresFormTerD_TT = PresFormTerD_TT + 1
Rem comincio a preparare l output
' Rigo 1
Scrivi " | " & FormatSpace(" ",4) & sSep & FormatSpace(" ",12) & sSep & GetInfoEstrazione(IdEstr) & sSep & StringaEstratti(IdEstr,aRuVer(1)) & sSep & _
FormatSpace("",2) & sSep,,0,,vbCyan
Scrivi "D ( " & FormatSpace(Eps,2) & " ) ",,0,,vbCyan
Scrivi sSep,,0,,vbCyan
Scrivi FormatSpace(StringaNumeri(aAmbD,,True),8),,0,,vbCyan
Scrivi sSep,,0,,vbCyan
Scrivi FrzADesRuota & sSep & FrzAdesTutte & sSep,,,,vbCyan
Rem Rigo 2
Scrivi " | " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
Scrivi "D ( " & FormatSpace(Es,2) & " ) ",,0,,vbCyan
Scrivi sSep,,0,,vbCyan
Scrivi FormatSpace(StringaNumeri(aTern1D,,True),8),,0,,vbCyan
Scrivi sSep,,0,,vbCyan
Scrivi FrzTern1DesRuota & sSep & FrzTern1DesTutte & sSep,,,,vbCyan
Rem rigo 3
Scrivi " | " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & Space(2) & sSep & _
Space(9) & sSep & FormatSpace(StringaNumeri(aTern2D,,True),8) & sSep & _
FrzTern2DesRuota & sSep & FrzTern2DesTutte & sSep,,,,vbCyan
Rem rigo 4
Scrivi LineasTit,,,,vbCyan
Else
Scrivi " | " & FormatSpace(" ",4) & sSep & FormatSpace(" ",12) & sSep & GetInfoEstrazione(IdEstr) & sSep & StringaEstratti(IdEstr,aRuVer(1)) & sSep & _
FormatSpace("",2) & sSep,,0,,vbCyan
Scrivi "D ( " & FormatSpace(Eps,2) & " ) ",1,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi String(8,"-"),,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,,,vbCyan
Rem Rigo 2
Scrivi " | " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & FormatSpace("",2) & sSep,,0,,vbCyan
Scrivi "D ( " & FormatSpace(Es,2) & " ) ",1,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi String(8,"-"),,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,,,vbCyan
Rem rigo 3
Scrivi " | " & FormatSpace("",4) & sSep & FormatSpace("",12) & sSep & Space(24) & sSep & Space(14) & sSep & Space(2) & sSep & _
Space(9) & sSep,,0,,vbCyan
Scrivi String(8,"-"),,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,0,,vbCyan
Scrivi "-",,0,,vbRed
Scrivi sSep,,,,vbCyan
Rem rigo 4
Scrivi LineasTit,,,,vbCyan
End If ' controllo se sono entrambi pari o dispari
Scrivi
End If ' Verifico che esistano gli estratti isotopi
If ScriptInterrotto Then Exit For
Next ' p
If ScriptInterrotto Then Exit For
End If ' verifico se l estrazione esiste
Next ' R
If ScriptInterrotto Then Exit For
Call AvanzamentoElab(Ini,Fin,IdEstr)
Next ' idestr
Scrivi : Scrivi
Scrivi " Info su : https://forum.lottoced.com/threads/terno-metodo-camaleonte.2191331/",1,,,RGB(255,128,0)
Scrivi " Info su : https://forum.lottoced.com/threads/camaleonte-in-terno-secco.96329/",1,,,RGB(255,128,0)
Scrivi
Scrivi " ",,0
Scrivi FormatSpace(" ",82),,,vbCyan
Scrivi " ",,0
Scrivi FormatSpace(" RESOCONTO SU : | " & StringaRuote(aRuSpia),80) & " ",,,vbCyan
Scrivi
Scrivi " Range Concorsi analizzati: | " & Ini & " - " & Fin,,,,vbCyan
Scrivi " ---------------------------------------------------------------------------------",,,,vbCyan
Scrivi " Estrazioni di verifica Metodo Aldini: | " & nClp ,,,,vbCyan
Scrivi " ---------------------------------------------------------------------------------",,,,vbCyan
Scrivi " Numero Casi Totali: | " & nCasiTro,,,,vbCyan
Scrivi " ---------------------------------------------------------------------------------",,,,vbCyan
Scrivi " Numero casi Giocabili a sinistra: | " & nCasiSin,,,,vbCyan
Scrivi " ---------------------------------------------------------------------------------",,,,vbCyan
Scrivi " Ambi a Ruota a Sinistra: | " & FrzAsinRuotaTotale,,,,vbCyan
Scrivi " Ambi a Tutte a Sinistra: | " & FrezAsinTutteTotale,,,,vbCyan
Scrivi " Casi Coperti Ambi su Ruota: | " & PresFormAmboS_Ru,,,,vbCyan
Scrivi " Casi Coperti Ambi su Tutte: | " & PresFormAmboS_TT,,,,vbCyan
Scrivi " Ambi In Terzina 1 a Ruota a Sinistra: | " & FrzTern1SinRuotaTotale,,,,vbCyan
Scrivi " Ambi In Terzina 1 a Tutte a Sinistra: | " & FrzTern1SinTutteTotale,,,,vbCyan
Scrivi " Ambi In Terzina 2 a Ruota a Sinistra: | " & FrzTern2SinRuotaTotale,,,,vbCyan
Scrivi " Ambi In Terzina 2 a Tutte a Sinistra: | " & FrzTern2SinTutteTotale,,,,vbCyan
Scrivi " Casi Coperti dalle due terzine su Ruota: | " & PresFormTerS_Ru,,,,vbCyan
Scrivi " Casi Coperti dalle due terzine su Tutte: | " & PresFormTerS_TT,,,,vbCyan
Scrivi " ---------------------------------------------------------------------------------",,,,vbCyan
Scrivi " Numero casi Giocabili a Destra: | " & nCasiDes,,,,vbCyan
Scrivi " ---------------------------------------------------------------------------------",,,,vbCyan
Scrivi " Ambi a Ruota a Destra: | " & FrzADesRuotaTotale,,,,vbCyan
Scrivi " Ambi a Tutte a Destra: | " & FrzAdesTutteTotale,,,,vbCyan
Scrivi " Casi Coperti Ambi su Ruota: | " & PresFormAmboD_Ru,,,,vbCyan
Scrivi " Casi Coperti Ambi su Tutte: | " & PresFormAmboD_TT,,,,vbCyan
Scrivi " Ambi In Terzina 1 a Ruota a Destra: | " & FrzTern1DesRuotaTotale,,,,vbCyan
Scrivi " Ambi In Terzina 1 a Tutte a Destra: | " & FrzTern1DesTutteTotale,,,,vbCyan
Scrivi " Ambi In Terzina 2 a Ruota a Destra: | " & FrzTern2DesRuotaTotale,,,,vbCyan
Scrivi " Ambi In Terzina 2 a Tutte a Destra: | " & FrzTern2DesTutteTotale,,,,vbCyan
Scrivi " Casi Coperti dalle due terzine su Ruota: | " & PresFormTerD_Ru,,,,vbCyan
Scrivi " Casi Coperti dalle due terzine su Tutte: | " & PresFormTerD_TT,,,,vbCyan
Scrivi " ---------------------------------------------------------------------------------",,,,vbCyan
End Sub
Function Specchietto(aV)
Dim R,s,s1,IdEstr,bRet,p,idR
s = ""
For R = 1 To 12
If R = 11 Then R = 12
s = s & Format2(R) & " ) " & SiglaRuota(R) & "... "
s1 = ""
For IdEstr = EstrazioneFin To EstrazioneFin - 9 Step - 1
bRet = False
For p = 1 To 5
If Estratto(IdEstr,R,p) = Estratto(IdEstr - 1,R,p) Then bRet = True :Exit For
Next 'p
If bRet Then s1 = s1 & " x ":Else s1 = s1 & " 0 "
Next 'idestr
s = s & s1 & vbCrLf
Next 'R
idR = InputBox(s,"Seleziona Numero/i Ruota di Ricerca,separati da punto","1.2.3.4.5.6.7.8.9.10.12")
If idR = "" Then Specchietto = False :Exit Function
aV = Split("0." & idR,".")
For p = 1 To UBound(aV)
If isRuotaValidaLotto(aV(p)) And aV(p) <> 11 Then
Specchietto = True
Else
Specchietto = False
Exit For
End If
Next
End Function
Sub Calcola(E1p,E1S,E0p,E0s,aAmb,aTern1,aTern2)
Dim op1:op1 = E1p + E1S
Dim op2:op2 = Differenza(E0p,E0s)
Dim op3:op3 = Fuori90((op1 + op2)/2)
Dim op4:op4 = Fuori90(Differenza(op1,op3))
Dim op5:op5 = Fuori90(op1 + 1)
Dim op6:op6 = Fuori90(op1 + 2)
aAmb = Array(0,op3,op4)
aTern1 = Array(0,op3,op4,op5)
aTern2 = Array(0,op3,op4,op6)
End Sub