Ragazzi ho trovato questi script spero servino a qualcuno
Scrivi Space(36)&"STATISTICHE LOTTO",1: ColoreTesto 1
Scrivi String(78,"=")&"listedrobyca",1 :ColoreTesto 0
Sub main()
Dim mtr(90,4),mrc(10,6),nu(1),ru(1),nm(10),nms(90,10)
Dim dn(9,13),totfrdn(9),totradn(9),totrsdn(9)
Dim cd(10,12),totfrcd(10),totracd(10),totrscd(10)
Dim fg(9,13),totfrfg(9),totrafg(9),totrsfg(9)
Dim trz(3),datitrz(30,3),rdl(4),datirdl(8,3)
Dim gem(8),datigem(3),dativrt(90,5),nr(2),ena(6)
Erase dativrt: Erase nms
ms=InputBox("INSERIRE IL NUMERO DEL MESE",,10):ms=CInt(ms)
r=InputBox("INSERIRE IL NUMERO DELLA RUOTA",,1):r=CInt(r):ru(1)=r
fin=EstrazioneFin: ini=3950
Scrivi "Questa statistica fornisce dati inerenti a tutti i mesi di "&_
MeseNome(ms)&" del periodo che và"&chr(13)&"dal "&DataEstrazione (ini)&_
" al "& DataEstrazione (fin)&" sulla ruota di "& NomeRuota(r),1 : Call righeu
Scrivi Chr(13)&"Archivio degli ultimi 5 anni di estrazioni in "& MeseNome(ms)&Chr(13)&_
Chr(13)&"Nmr. Data Lotto"&Space(29)&"Superenalotto"&Chr(13)&Chr(13),1
c1=0: For x=1 To 9: For y=0 To 9:c1=c1+1:dn(x,y+1)=c1-1: Next : Next :dn(1,1)=90
For x=1 To 10: For y=0 To 8:cd(x,y+1)=x+(10*y): Next : Next
For x=1 To 9: For y=0 To 9:fg(x,y+1)=x+(9*y): Next : Next
gem(1)=11:gem(2)=22:gem(3)=33:gem(4)=44:gem(5)=55:gem(6)=66:gem(7)=77:gem(8)=88
For x=1 To 90:mtr(x,1)=x:nms(x,1)=x: Next
For es=ini To fin: Messaggio NomeRuota(r)&" "& MeseNome(ms)&" "& Anno(es)
If Mese(es)=ms Then
c0=c0+1
For x=1 To 90:nms(x,9)=nms(x,9)+1:fn=Posizione(es,r,x)
If fn=0 Then mtr(x,3)=mtr(x,3)+1
If fn>0 Then mtr(x,2)=mtr(x,2)+1:mtr(x,3)=0
If mtr(x,4)<mtr(x,3) Then mtr(x,4)=mtr(x,3)
Next
For p=1 To 6:ns=Estratto(es,,p,1):ena(p)=ns
nms(ns,8)=nms(ns,8)+1:nms(ns,p+1)=nms(ns,p+1)+1
If nms(ns,10)<nms(ns,9) Then nms(ns,10)=nms(ns,9)
nms(ns,9)=0: Next
OrdinaMatrice ena,+1
If es>(fin-520) Then : ColoreTesto 1: Scrivi es&" "& DataEstrazione(es)&_
" "& StringaEstratti(es,r)&Space(20)& StringaNumeri(ena),1: ColoreTesto 0
nm(0)=0: For x=1 To 9: For y=1 To 10:nm
=dn(x,y): Next
fdn=0:fdn=SerieFreq(es,es,nm,ru,2)
If fdn=0 Then totradn(x)=totradn(x)+1
If fdn>0 Then totfrdn(x)=totfrdn(x)+fdn:totradn(x)=0
If totrsdn(x)<totradn(x) Then totrsdn(x)=totradn(x)
Erase nm : Next
nm(0)=0: For x=1 To 10: For y=1 To 9:nm
=cd(x,y): Next
frcd=0:frcd=SerieFreq(es,es,nm,ru,2)
If frcd=0 Then totracd(x)=totracd(x)+1
If frcd>0 Then totfrcd(x)=totfrcd(x)+frcd:totracd(x)=0
If totrscd(x)<totracd(x) Then totrscd(x)=totracd(x)
Erase nm: Next
nm(0)=0: For x=1 To 9: For y=1 To 10:nm
=fg(x,y): Next
frfg=0:frfg=SerieFreq(es,es,nm,ru,2)
If frfg=0 Then totrafg(x)=totrafg(x)+1
If frfg>0 Then totfrfg(x)=totfrfg(x)+frfg:totrafg(x)=0
If totrsfg(x)<totrafg(x) Then totrsfg(x)=totrafg(x)
Erase nm: Next
For x=1 To 30:trz(1)=x:trz(2)=x+30:trz(3)=x+60
ftrz=0:ftrz=SerieFreq(es,es,trz,ru,2)
If ftrz=0 Then datitrz(x,2)=datitrz(x,2)+1
If ftrz>0 Then datitrz(x,1)=datitrz(x,1)+ftrz:datitrz(x,2)=0
If datitrz(x,3)<datitrz(x,2) Then datitrz(x,3)=datitrz(x,2)
Next
For x=1 To 8:rdl(1)=x:rdl(2)=x*10:rdl(3)=rdl(2)+x:rdl(4)=rdl(2)+9
frdl=0:frdl=SerieFreq(es,es,rdl,ru,2)
If frdl=0 Then datirdl(x,2)=datirdl(x,2)+1
If frdl>0 Then datirdl(x,1)=datirdl(x,1)+frdl:datirdl(x,2)=0
If datirdl(x,3)<datirdl(x,2) Then datirdl(x,3)=datirdl(x,2)
Next
fgem=0:fgem=SerieFreq(es,es,gem,ru,2)
If fgem=0 Then datigem(2)=datigem(2)+1
If fgem>0 Then datigem(1)=datigem(1)+fgem:datigem(2)=0
If datigem(3)<datigem(2) Then datigem(3)=datigem(2)
For x=1 To 90:dativrt(x,1)=x:nr(1)=x:dativrt(x,2)=Vert(x):nr(2)=Vert(x)
fvrt=0:fvrt=SerieFreq(es,es,nr,ru,2)
If fvrt=0 Then dativrt(x,4)=dativrt(x,4)+1
If fvrt>0 Then dativrt(x,3)=dativrt(x,3)+fvrt:dativrt(x,4)=0
If dativrt(x,5)<dativrt(x,4) Then dativrt(x,5)=dativrt(x,4)
Next
End If : Next
Call righeu: Scrivi Chr(13)&"Estratti ordinati per"&Space(11)&"FREQUENZA"&Space(25)&_
"RITARDO"&Chr(13)&Space(11)&"Pos."&Space(13)&"N."&Space(5)&"Fre."&Space(3)&"R.Att."&_
Space(13)&"N."&Sp