R
Roby
Guest
Sub main()
'rif. 0902_67e+Co Ro x Lottologo numeri sempre presenti(?!?)
'VALIDO PER PIU' CAPOGIOCO - OUTPUT SORTITE COMPATTATO
'verifico le PRESENZE a TUTTE degli abbinamenti e poi cerco quelle più frequenti
'Attenzione: conta le presenze e non le frequenze: se in una stessa estrazione un abbinamento
'si presenta su due o più ruote con il CG in esame, viene conteggiata 1 sola presenza
Dim nu(1),tt(1),temp(90),stat(90,2),num(),ru(1),abbin(90), comuni()
'----------------------------------------------------------------------
c=InputBox("Inserire i Capogioco che vuoi analizzare, separati da punto",,"60.28.55.83")
qes=InputBox("Quante estrazioni vuoi analizzare?",,15)-1
fr=CInt(InputBox("Scegli la freq minima per la verifica delle sortite?",,2))-1
For i= 1 To 90 : stat(i,1)=i : Next
tt(1)=11
Redim comuni(0)
ini=EstrazioneFin-qes
fin=EstrazioneFin
'-----------------------------------------------------------------------
If c="" Then Exit Sub
c="0."&c
cg=Split(c,".")
x=UBound(cg)
For i=1 To x: cg(i)=CInt(cg(i)) : Next
'--------------------------------------------------------------
ColoreTesto 2
Scrivi " RICERCA CON "& x & " CAPOGIOCO -> "& StringaNumeri(cg),1
Scrivi " SU "& SiglaRuota(r),1
Scrivi " ESTRAZIONI ESAMINATE: "& qes+1&" dal "& DataEstrazione(ini) & " a " &_
DataEstrazione(fin)& Chr(10)&string(60,"=")&chr(10),1: ColoreTesto 0
'-----------------------------------------------------------
For w= 1 To x
nu(1)=cg(w): t=0 : ko=0
For i= 1 To 90 : stat(i,2)=0 : Next
OrdinaMatrice stat,1,1
'------------------------
For es=ini To fin
Erase temp
If SerieFreq(es,es,nu,tt,1)>0 Then
For r= 1 To 10
If Posizione(es,r,nu(1))>0 Then
For p=1 To 5
If Estratto(es,r,p) <> nu(1) Then
n=Estratto(es,r,p)
temp=1
End If
Next
End If
Next
End If
For i= 1 To 90
If temp(i)=1 Then stat(i,2)=stat(i,2)+1
Next
Next
OrdinaMatrice stat,-1,2
Redim num(0) : maxfre=stat(1,2)
For i= 1 To 90
If stat(i,2)>0 Then t=t+1
If stat(i,2)>fr Then
ko=ko+1 : Redim preserve num(ko) : num(ko)=stat(i,1)
kt=kt+1 : abbin(kt)=stat(i,1)
End If
Next
'-------------------------------------------------------------
ColoreTesto 1
Scrivi t & " Abbinamenti sortiti insieme al ",1,0 :coloretesto 2: Scrivi " CG " & nu(1)&Chr(10),1
rigo=""
For f= maxfre To 1 step-1
rigo="Freq "& f & "-> "
For i= 1 To 90
If stat(i,2)=f Then rigo=rigo & Format2(stat(i,1))& " "
Next
ColoreTesto 1 : Scrivi rigo
Next
Scrivi ko &" abbinamenti a freq minima = "& Fr+1 & " -> ",1,0: ColoreTesto 0
Scrivi StringaNumeri(num)&chr(10),1: ColoreTesto 0
Scrivi String(100,"-")
Next
'=====================================================
For i= 1 To kt-1
For y= i+1 To kt
If abbin=abbin(i) Then
trova=trova+1
Redim preserve comuni(trova)
comuni(trova)=Format2(abbin)
End If
Next
Next
EliminaRipetuti(comuni)
EliminaRipetuti(abbin)
riga="" : trovati=0
For i= 1 To x
For y= 1 To kt
If abbin=cg(i) Then riga=riga& Format2(abbin)& " ": abbin=0 : trovati=1
Next
Next
OrdinaMatrice abbin,-1
'----------------------------------------------------------stop controlli
OrdinaMatrice cg
Scrivi Chr(10)&chr(10)& Space(4)& "V E R I F I C A ",1
Scrivi "Sortite dei Capogioco -----> ",1,0: ColoreTesto 2: Scrivi StringaNumeri(cg),1
ColoreTesto 0
Scrivi "con abbin. a freq min = "& Fr+1 & " -> "& StringaNumeri(abbin),1
Scrivi String(100,"-") : ColoreTesto 2
If trovati= 1 Or trova >0 Then Scrivi "NB: durante l'elaborazione ho trovato: "
If trova>0 Then Scrivi "- questi -> "& StringaNumeri(comuni) &" abbinamenti 'comuni' a più CG"
If trovati=1 Then Scrivi "- questi -> "& riga &" abbinamenti che sono anche dei Capogioco."
ColoreTesto 0
Scrivi String(100,"-")&chr(10)
'----------------------------------------------
For es=ini To fin
Messaggio(es)
Scrivi "["&Dataestrazione(es)&"] ",0,0
ktr=0
For r= 1 To 10
ru(1)=r
If SerieFreq(es,es,cg,ru,1)>0 Then
ktr=ktr+1
If ktr=1 Then Scrivi SiglaRuota(r)& " ",0,0 Else Scrivi Space(13)&SiglaRuota(r)& " ",0,0
trovat
'rif. 0902_67e+Co Ro x Lottologo numeri sempre presenti(?!?)
'VALIDO PER PIU' CAPOGIOCO - OUTPUT SORTITE COMPATTATO
'verifico le PRESENZE a TUTTE degli abbinamenti e poi cerco quelle più frequenti
'Attenzione: conta le presenze e non le frequenze: se in una stessa estrazione un abbinamento
'si presenta su due o più ruote con il CG in esame, viene conteggiata 1 sola presenza
Dim nu(1),tt(1),temp(90),stat(90,2),num(),ru(1),abbin(90), comuni()
'----------------------------------------------------------------------
c=InputBox("Inserire i Capogioco che vuoi analizzare, separati da punto",,"60.28.55.83")
qes=InputBox("Quante estrazioni vuoi analizzare?",,15)-1
fr=CInt(InputBox("Scegli la freq minima per la verifica delle sortite?",,2))-1
For i= 1 To 90 : stat(i,1)=i : Next
tt(1)=11
Redim comuni(0)
ini=EstrazioneFin-qes
fin=EstrazioneFin
'-----------------------------------------------------------------------
If c="" Then Exit Sub
c="0."&c
cg=Split(c,".")
x=UBound(cg)
For i=1 To x: cg(i)=CInt(cg(i)) : Next
'--------------------------------------------------------------
ColoreTesto 2
Scrivi " RICERCA CON "& x & " CAPOGIOCO -> "& StringaNumeri(cg),1
Scrivi " SU "& SiglaRuota(r),1
Scrivi " ESTRAZIONI ESAMINATE: "& qes+1&" dal "& DataEstrazione(ini) & " a " &_
DataEstrazione(fin)& Chr(10)&string(60,"=")&chr(10),1: ColoreTesto 0
'-----------------------------------------------------------
For w= 1 To x
nu(1)=cg(w): t=0 : ko=0
For i= 1 To 90 : stat(i,2)=0 : Next
OrdinaMatrice stat,1,1
'------------------------
For es=ini To fin
Erase temp
If SerieFreq(es,es,nu,tt,1)>0 Then
For r= 1 To 10
If Posizione(es,r,nu(1))>0 Then
For p=1 To 5
If Estratto(es,r,p) <> nu(1) Then
n=Estratto(es,r,p)
temp=1
End If
Next
End If
Next
End If
For i= 1 To 90
If temp(i)=1 Then stat(i,2)=stat(i,2)+1
Next
Next
OrdinaMatrice stat,-1,2
Redim num(0) : maxfre=stat(1,2)
For i= 1 To 90
If stat(i,2)>0 Then t=t+1
If stat(i,2)>fr Then
ko=ko+1 : Redim preserve num(ko) : num(ko)=stat(i,1)
kt=kt+1 : abbin(kt)=stat(i,1)
End If
Next
'-------------------------------------------------------------
ColoreTesto 1
Scrivi t & " Abbinamenti sortiti insieme al ",1,0 :coloretesto 2: Scrivi " CG " & nu(1)&Chr(10),1
rigo=""
For f= maxfre To 1 step-1
rigo="Freq "& f & "-> "
For i= 1 To 90
If stat(i,2)=f Then rigo=rigo & Format2(stat(i,1))& " "
Next
ColoreTesto 1 : Scrivi rigo
Next
Scrivi ko &" abbinamenti a freq minima = "& Fr+1 & " -> ",1,0: ColoreTesto 0
Scrivi StringaNumeri(num)&chr(10),1: ColoreTesto 0
Scrivi String(100,"-")
Next
'=====================================================
For i= 1 To kt-1
For y= i+1 To kt
If abbin=abbin(i) Then
trova=trova+1
Redim preserve comuni(trova)
comuni(trova)=Format2(abbin)
End If
Next
Next
EliminaRipetuti(comuni)
EliminaRipetuti(abbin)
riga="" : trovati=0
For i= 1 To x
For y= 1 To kt
If abbin=cg(i) Then riga=riga& Format2(abbin)& " ": abbin=0 : trovati=1
Next
Next
OrdinaMatrice abbin,-1
'----------------------------------------------------------stop controlli
OrdinaMatrice cg
Scrivi Chr(10)&chr(10)& Space(4)& "V E R I F I C A ",1
Scrivi "Sortite dei Capogioco -----> ",1,0: ColoreTesto 2: Scrivi StringaNumeri(cg),1
ColoreTesto 0
Scrivi "con abbin. a freq min = "& Fr+1 & " -> "& StringaNumeri(abbin),1
Scrivi String(100,"-") : ColoreTesto 2
If trovati= 1 Or trova >0 Then Scrivi "NB: durante l'elaborazione ho trovato: "
If trova>0 Then Scrivi "- questi -> "& StringaNumeri(comuni) &" abbinamenti 'comuni' a più CG"
If trovati=1 Then Scrivi "- questi -> "& riga &" abbinamenti che sono anche dei Capogioco."
ColoreTesto 0
Scrivi String(100,"-")&chr(10)
'----------------------------------------------
For es=ini To fin
Messaggio(es)
Scrivi "["&Dataestrazione(es)&"] ",0,0
ktr=0
For r= 1 To 10
ru(1)=r
If SerieFreq(es,es,cg,ru,1)>0 Then
ktr=ktr+1
If ktr=1 Then Scrivi SiglaRuota(r)& " ",0,0 Else Scrivi Space(13)&SiglaRuota(r)& " ",0,0
trovat