L
LuigiB
Guest
ciao come ti avevo detto mancavano de parametri alla funzione che avevi individuato anche tu ..l'ho corretta
e poi evita di usare i : per gli script da compilare
e poi evita di usare i : per gli script da compilare
Codice:
Option Explicit
Sub Main
'''''Beppignello
Dim n,r,fine,ini,rit,max,y,ct,qt,retestratti,retidestr,v,des,b,j,retesito,aretritardi,aretidestr
Dim Forzatot,presrea,teopres,teobrev,molla10c,cqt,ctb,rsl,anm,RS,rslSINGLE,nretliv,ixp,nconc
Dim ar(1),an(1),esi(5)
fine = InputBox("fino Estraz.n.",,EstrazioneFin)
r = InputBox("Verifica Ruota ",,1)
rit = InputBox("RT scelto ",,31)
nconc = CInt(InputBox("N.Estraz.",,13))
ini = 3950 ''' inizio venus e nz
''
teopres = Int((fine - 3950)/18 + 0.99)
teobrev = 10
'''
Scrivi
Scrivi "Bep-LottoQuantitativo-Tabelloni " & " ************** 1° Quadro statistico ROOKIE/Buchi e Presenze a RT(x) *************** ",1,2,4
Scrivi "Situazione dalla estr.n.7440 ad oggi dei Numeri a Livello (1) della cinquina estratta ",1
Scrivi "Verifica esiti e creazione Vuoto nella sequenza Ritardi ",1
Scrivi
''''''
'''situazione buchi nell'estrazione
Call buchivuoti(fine,rit,ini)
'''''''''''''''''''''''''''''''''''
Scrivi
Scrivi "Bep-LottoQuantitativo-Tabelloni " & " ************** 2° Quadro statistico Urne TT e Presenze = 0 *************** ",1,2,4
Call urne(fine,nconc)
'''''''''''''''''''''''''
Scrivi "Tempo Elab. " & TempoTrascorso,1
End Sub
Function buchivuoti(fine,rit,Ini)
Dim nub,ritab,rub,yb,lista,cqt,ru,w,z,ctb,retrit,retritmax,listavert,vqt,retfre,ct,ruo,nc,ELE,P,AA,BB,teos,teob,frebre,yy,v,xx,j,j1,j2,so,qq
Dim fre,teo,desc,dif,listaup,rs,Totrs,an,nretliv,fmedio72,Totl1,tgv,tv,listateo,RC,rsL,IXP,freLUN,ARETRITARDI,ARETIDESTR,listaverRsl
ReDim riga(35),ar(1)
ColoreTesto(1)
Scrivi "Situazione all'estrazione n." & fine & " / " & DataEstrazione(fine),1,2,4
Scrivi "TURT RT Vuoti nella Ruota(X) sono calcolati da RT>4 AND RT<35 ",1,2,4
Scrivi "Dove compara (X) significa che non c'è presente nessun L5:L1 cioè è BucoVuoto ",1,2,4
Scrivi "In Verticale (BP) e Qt.Buchi Con Misto Numeri da L5:L1 nelle 10 Ruote",1,2,4
Scrivi "Ru- -Qt--> Rt | 05| 06| 07| 08| 09| 10| 11| 12| 13| 14| 15| 16| 17| 18| 19| 20| 21| 22| 23| 24| 25| 26| 27| 28| 29| 30| 31| 32| 33| 34| Teo Dif |",1
ColoreTesto(0)
''''''loop per 10 ruote
ReDim glo(10,300,3),Verti(35)
For rub = 1 To 10
lista = "" : ctb = 0
'''calcola valori rt come tabellone ritardi di ogni ruota
ReDim rcb(300,3)
For nub = 1 To 90
ritab = EstrattoRitardoTurbo(rub,nub,fine - 500,fine)
rcb(ritab,1) = FormattaStringa(ritab,"000")
rcb(ritab,2) = rcb(ritab,2) & Format2(nub) & "."
rcb(ritab,3) = rcb(ritab,3) + 1
''
glo(rub,ritab,1) = FormattaStringa(ritab,"000")
glo(rub,ritab,2) = glo(rub,ritab,2) & Format2(nub) & "."
glo(rub,ritab,3) = glo(rub,ritab,3) + 1
Next
''''cerca rt = 0 corrisponde a buco vuoto(senza numeri) nel ritardo
For yb = 5 To 34
If yb > 4 And yb < 35 Then
If Int(rcb(yb,1)) < 1 And yb > 4 And yb < 35 Then
riga(yb) = " X |"
lista = lista & " X |"
ctb = ctb + 1
Verti(yb) = Verti(yb) + 1
Else
If yb = 5 Then
riga(yb) = "| |"
lista = " | |"
Else
riga(yb) = " "
lista = lista & " |"
End If
End If
End If
Next
ColoreTesto(0)
Scrivi SiglaRuota(rub) & " " & Format2(ctb) & " " & lista,1
ColoreTesto(0)
Next
ColoreTesto(0)
''''accumula quanti numeri L1 per situazione - Verticale
listavert = "Vuoti |"
For yb = 5 To 34
If Verti(yb) <> "" Or Verti(yb) <> 0 Then
listavert = listavert & " " & Format2(Verti(yb)) & "|"
Else
listavert = listavert & " BP|"
End If
Next
Scrivi listavert
Scrivi
ReDim riga(35),Verti(35),verrsl(35)
ColoreTesto(1)
Scrivi "Situazione all'estrazione n." & fine & " / " & DataEstrazione(fine),1,3,4
Scrivi "Quantità Ultima Estrazione di Numeri L1 presenti ai vari Rt ",1,2,4
ColoreTesto(1)
Scrivi "Ru- -QO-RtL1->| 05| 06| 07| 08| 09| 10| 11| 12| 13| 14| 15| 16| 17| 18| 19| 20| 21| 22| 23| 24| 25| 26| 27| 28| 29| 30| 31| 32| 33| 34| RE /Rx TRsl | Teo Dif |",1
ColoreTesto(0)
For rub = 1 To 10
lista = " | " : cqt = 0 : an = 0: Totrs = 0:Totl1 = 0
ar(1) = rub
ReDim nr(18)
''''conta tutti gli L1 x tutti gli RT
For yb = 1 To 300
If glo(rub,yb,3) = 1 Then
Totl1 = Totl1 + 1
tgv = tgv + 1
End If
Next
''''cerca L1 x RT
For yb = 5 To 34
If glo(rub,yb,3) <> 1 Then
lista = lista & " | "
End If
If glo(rub,yb,3) = 1 Then
cqt = cqt + 1
tv = tv + 1
lista = lista & Left(glo(rub,yb,2),2) & "| "
nr(cqt) = Left(glo(rub,yb,2),2)
Verti(yb) = Verti(yb) + 1
''''calcola somma rsl di ogni numero L1 attuale
'''calcola rsl e somma e vede max
an = Int(nr(cqt))
rs = RitSincDiLiv(an,ar,fine,nretliv)
Totrs = Totrs + rs
verrsl(yb) = verrsl(yb) + rs
End If
Next
''''calcola ritardo per estratto e massimo ritardo della comb.intera dei numeri L1 - Orizzontali
Call StatisticaFormazioneTurbo(nr,ar,1,retrit,retritmax,0 , 0,Ini,fine)
lista = lista & Format2(retrit) & " " & Format2(retritmax) & " " & FormattaStringa(Totrs,"000") & " | "
'''calcola pres.teoriche e dif
teo = 90*((17/18)^retrit) /3
dif = Totl1 - teo
ColoreTesto(0)
If dif < 0 Then
dif = 0 - dif
End If
If dif >= 0 Then
Scrivi SiglaRuota(rub) & " " & Format2(cqt) & " " & Format2(Totl1) & lista & " " & FormatSpace(Format2(teo),4) & Format2(dif) & " | ",1
End If
ColoreTesto(0)
Next
Scrivi "--------------------------------------------------------------------------------------------------------------------------------------",1
ColoreTesto(0)
''''accumula quanti numeri L1 per situazione - Verticale
listateo = "" :listaverRsl = ""
listavert = "T.QV " & tv & " " & tgv & " |"
For yb = 5 To 34
If Verti(yb) <> "" Or Verti(yb) <> 0 Then
listaverRsl = listaverRsl & FormattaStringa(verrsl(yb)," 00") & "|"
listavert = listavert & " " & Format2(Verti(yb)) & "|"
listateo = listateo & " " & Format2((45*((85/90)^yb) + .99)) & "|"
Else
listavert = listavert & " 0|"
listateo = listateo & " 0|"
listaverRsl = listaverRsl & " 0|"
End If
Next
Scrivi listavert
listavert = "Teo RtV |" & listateo
Scrivi listavert
Scrivi "TverRsl |" & listaverRsl
'''
'''''''calcola numeri verticali per RT trova presenze teorica e frequenza globale e stabilisce se Trend Up o Trend Down
''''Rileggi e crea matrice verticale
''''cerca solo L1 x RT
Scrivi
Scrivi
ReDim numeri(10),ruote(10)
For yb = 5 To 34
ReDim nr(10),ar(10),aru(1)
vqt = 0:Totrs = 0
listaup = " |"
For rub = 1 To 10
If glo(rub,yb,3) = 1 Then
vqt = vqt + 1
nr(vqt) = Left(glo(rub,yb,2),2)
ar(vqt) = rub
'''calcola somma rs
an = Int(nr(vqt))
aru(1) = rub
rs = RitSincDiLiv(an,aru,fine,nretliv)
Totrs = Totrs + rs
If yb = Int(rit) Then
ct = ct + 1
numeri(ct) = an
ruote(ct) = rub
End If
End If
Next
Next
Scrivi "SITUAZIONE Verticali a RT = " & rit,1,2,4
Scrivi "Numeri " & StringaNumeri(numeri,"."),1,2,4
Scrivi "Ruote " & StringaNumeri(ruote,"."),1,2,4
Scrivi
nc = fine - rit
Scrivi "Situazione all'estrazione n." & fine & " / " & DataEstrazione(fine),1,3,4
''''''''tabella riepilogativa dei numeri e ruote richiesti
Scrivi "Ruo Nr. -- ESTRATTI -- Rc. Rsl --%-- Liv FreS. FreTeoS - FreB. FreTeoB ",1
For ruo = 1 To 10
ELE = ""
Messaggio(ruo)
If ruote(ruo) > 0 Then
ReDim MatriceEstrRitorno(5)
Call GetArrayNumeriRuota(nc,ruote(ruo),MatriceEstrRitorno)
For P = 1 To 5
If MatriceEstrRitorno(P) = numeri(ruo) Then
ELE = ELE & Format2(numeri(ruo)) & "."
Else
ELE = ELE & "--."
End If
Next
RC = EstrattoRitardoTurbo(ruote(ruo),numeri(ruo),3950,fine)
rsL = RitSincDiLiv(numeri(ruo),ruote(ruo),fine,nretliv)
IXP = Round(rsL/RC,3)
AA = ruote(ruo) : BB = numeri(ruo)
freLUN = EstrattoFrequenzaTurbo(AA,BB,3950,fine)
frebre = EstrattoFrequenzaTurbo(AA,BB,fine - 72,fine)
teos = Int((fine - 3950)/18 + .99)
teob = Int((fine -(fine - 72))/18 + .99)
Scrivi FormatSpace(SiglaRuota(ruote(ruo)),5) & FormatSpace(numeri(ruo),5) & FormatSpace(ELE,19) & FormatSpace(Format2(RC),5) & FormatSpace(Format2(rsL),5) & FormatSpace(IXP,9) & FormatSpace(nretliv,5) & FormatSpace(freLUN,8) & FormatSpace(teos,10) & FormatSpace(frebre,8) & FormatSpace(teob,5)
End If
Next
''''''''''''
'''''ricerca nelle lunghette orizzontali le coppie di numeri di figura 9
''''''''''''''
Scrivi
Scrivi "Ricerca Coppie di estratti di Figura 9 per tentare Estratto ed ambo",1,2,4
ColoreTesto(1)
Scrivi "Ru- -QO-RtL1->| 05| 06| 07| 08| 09| 10| 11| 12| 13| 14| 15| 16| 17| 18| 19| 20| 21| 22| 23| 24| 25| 26| 27| 28| 29| 30| 31| 32| 33| 34|",1
ColoreTesto(0)
For rub = 1 To 10
lista = " | " : cqt = 0 : an = 0: Totrs = 0:Totl1 = 0
ar(1) = rub
ReDim nr(18)
''''conta tutti gli L1 x tutti gli RT
For yb = 1 To 300
If glo(rub,yb,3) = 1 Then
Totl1 = Totl1 + 1
tgv = tgv + 1
End If
Next
''''cerca L1 x RT
ReDim num(34)
For yb = 5 To 34
If glo(rub,yb,3) <> 1 Then
lista = lista & " | "
End If
If glo(rub,yb,3) = 1 Then
''''''''''''''''''''''''
cqt = cqt + 1
tv = tv + 1
lista = lista & Left(glo(rub,yb,2),2) & "| "
nr(cqt) = Left(glo(rub,yb,2),2)
Verti(yb) = Verti(yb) + 1
''''calcola somma rsl di ogni numero L1 attuale
'''calcola rsl e somma e vede max
an = Int(nr(cqt))
rs = RitSincDiLiv(an,ar,fine,nretliv)
Totrs = Totrs + rs
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''verifica se c'è coppia o piu estratti con figura 9
yy = 4 : lista = " | "
For v = 5 To 34
If glo(rub,v,3) = 1 Then
xx = Left(glo(rub,v,2),2)
If xx > 0 And Figura(xx) = 9 Then
yy = yy + 1
num(yy) = xx
lista = lista & num(yy) & "| "
Else
lista = lista & " | "
End If
Else
lista = lista & " | "
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''calcola pres.teoriche e dif
teo = 90*((17/18)^retrit) /3
dif = Totl1 - teo
ColoreTesto(0)
If dif < 0 Then
dif = 0 - dif
End If
If dif >= 0 Then
Scrivi SiglaRuota(rub) & " " & Format2(cqt) & " " & Format2(Totl1) & lista,1
End If
ColoreTesto(0)
Next
Scrivi "--------------------------------------------------------------------------------------------------------------------------------------",1
''''''''''''
'''''ricerca nelle lunghette orizzontali le coppie di numeri di figura 9
''''''''''''''
Scrivi:Scrivi "Ricerca Coppie Simmetriche di estratti di somma 90 e 91 per tentare Estratto ed ambo",1,2,4
ColoreTesto(1)
Scrivi "Ru- -QO-RtL1->| Coppie di Somma | 01-02-03-04-05-06-07-08-09-10-11-12-13-14-15-16-17-18-19-20-21-22-23-24-25-26-27-28-29-30 ",1
ColoreTesto(0)
For rub = 1 To 10
lista = " | " : cqt = 0 : an = 0: Totrs = 0:Totl1 = 0
ar(1) = rub
ReDim nr(18)
''''conta tutti gli L1 x tutti gli RT
For yb = 1 To 300
If glo(rub,yb,3) = 1 Then
Totl1 = Totl1 + 1
tgv = tgv + 1
End If
Next
''''cerca L1 x RT
ReDim num(34)
For yb = 5 To 34
If glo(rub,yb,3) <> 1 Then
lista = lista & " | "
End If
If glo(rub,yb,3) = 1 Then
''''''''''''''''''''''''
cqt = cqt + 1
tv = tv + 1
lista = lista & Left(glo(rub,yb,2),2) & "| "
nr(cqt) = Left(glo(rub,yb,2),2)
Verti(yb) = Verti(yb) + 1
''''calcola somma rsl di ogni numero L1 attuale
'''calcola rsl e somma e vede max
an = Int(nr(cqt))
rs = RitSincDiLiv(an,ar,fine,nretliv)
Totrs = Totrs + rs
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''verifica se c'è coppia o piu estratti con somma 90 o 91
yy = 4 : lista = " | " :yy = 0
For v = 5 To 34
If glo(rub,v,3) = 1 Then
xx = Left(glo(rub,v,2),2)
If xx > 0 Then
yy = yy + 1
num(yy) = xx
End If
End If
Next
qq = 0
For j1 = 1 To yy - 1
For j2 = j1 + 1 To yy
so = Int(num(j1)) + Int(num(j2))
If Fuori90(so) = 90 Or Fuori90(so) = 91 Then
lista = lista & "Somma " & so & GetTestoHtml(" Nr." & num(j1) & " " & Format2(num(j2)),True,vbBlue) & " | "
qq = 1
End If
Next
Next
If qq = 0 Then lista = lista & " | "
lista = lista & StringaNumeri(num,"-")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''calcola pres.teoriche e dif
teo = 90*((17/18)^retrit) /3
dif = Totl1 - teo
ColoreTesto(0)
If dif < 0 Then
dif = 0 - dif
End If
If dif >= 0 Then
Scrivi SiglaRuota(rub) & " " & Format2(cqt) & " " & Format2(Totl1) & lista,1
End If
ColoreTesto(0)
Next
Scrivi "--------------------------------------------------------------------------------------------------------------------------------------",1
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function urne(fine,nconc)
Dim fr,g,hh,elenco2,Ini,Iniz,MatriceEstrRitorno,r,y,n,ctr,jj,m,nn,v,retestratti,retidestr,z,rc
ReDim tutte(90,2),elenco2(150,3),very(90),ar(10)
ColoreTesto(0)
Scrivi
Scrivi "Distribuzione con metodica Urne *** T U T T E *** ",1,5,4
Scrivi "Lunghezza Complessiva del Ciclo Richiesto " & nconc,1,2,4
Ini = fine - nconc
Iniz = fine - nconc
ReDim nm(90,2)
For Ini = Ini + 1 To fine
Messaggio(Ini)
Call GetEstrazioneCompleta(Ini,MatriceEstrRitorno)
For r = 1 To 10
For y = 1 To 5
n = Format2(MatriceEstrRitorno(r,y))
nm(n,2) = Format2(n)
nm(n,1) = nm(n,1) + 1
Next
Next
'''''controlla se usciti tutti i 90nr
ctr = 0
For jj = 1 To 90
If nm(jj,1) > 0 Then
ctr = ctr + 1
End If
Next
'''
If ctr = 90 Then
Scrivi "Ciclo Durata " & Format2(Ini - Iniz) & " Estraz. Inizio " & Iniz + 1 & " : fine " & Ini,1
Iniz = Ini
ReDim nm(90,2)
End If
Next
''''ciclo attuale in corso
'''''
ColoreTesto(2)
Scrivi
Scrivi "Ciclo In Corso Durata " & Format2(fine - Iniz) & " Estraz. Inizio " & Iniz + 1 & " : fine " & Ini - 1,1
ColoreTesto(0)
''''conta per presenze quantità di estratti
''m=presenze
For m = 0 To 15
ReDim cp(15,2)
For nn = 1 To 90
If nm(nn,1) > 0 And nm(nn,1) = m Then
cp(m,1) = cp(m,1) + 1
cp(m,2) = cp(m,2) & Format2(nm(nn,2)) & "."
'''''mette in arrays x verifica esiti lunghetta con presenze 0,1,2
If m < 1 Then
v = v + 1
very(v) = Format2(nn)
End If
End If
If nm(nn,1) = 0 And nm(nn,1) = m Then
cp(m,1) = cp(m,1) + 1
cp(m,2) = cp(m,2) & Format2(nn) & "."
v = v + 1
very(v) = Format2(nn)
End If
Next
If cp(m,1) > 0 Then
Scrivi "Pr. " & Format2(m) & " Qt." & Format2(cp(m,1)) & " Estratti...... " & cp(m,2)
End If
Next
'''''''''verifica esiti lunghetta composta dai nr. con presenze 0,1,2
If v > 2 Then
ar(1) = 11
Scrivi
Scrivi "Combinazione da verificare " & StringaNumeri(very,"."),1
Call VerificaEsitoTurbo(very,ar,fine + 1,2,,,,,retestratti,retidestr)
If retestratti <> "" Then
ColoreTesto(2)
Scrivi retidestr & " Colpo n." & Format2(retidestr - fine) & " " & retestratti,1
ColoreTesto(0)
End If
End If
Scrivi:Scrivi "Situazione Corrente Ritardo a Tutte ",1,2,4
For z = 1 To v
rc = EstrattoRitardo(11,very(z),fine - 50,fine)
Scrivi "Estratto " & Format2(very(z)) & " R.c." & Format2(rc),1,6,2
Next
Scrivi "--------------------------------------------------------------------------------------------------------------------------------------",1
End Function
