Novità

Suggerimento "Aiuto"

P

Pattydreams64

Member
Volevo sapere se con excel era possibile con una macro dividere le estrazioni di Venezia dal 1800fino al 2013 in mesi
oppure se e possibile con script , in modo da vedere quali numeri sortiscono maggiormente in alcuni mesi ( tipo Giugno)
Grazie
 
Ciao Pattydreams64 lo script che cerchi non lo so fare pero' ho qualcosa che forse ti potra' essere utile , ciao :

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(y) = 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(y) = 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(y) = 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." & Space(5) & "Fre." & Space(3) & "R.Att.",1


For y = 2 To 3: OrdinaMatrice mtr,- 1,y: For x = 1 To 10
If y = 2 Then mrc(x,1) = mtr(x,1):mrc(x,2) = mtr(x,2):mrc(x,3) = mtr(x,3) Else _
mrc(x,4) = mtr(x,1):mrc(x,5) = mtr(x,2):mrc(x,6) = mtr(x,3)
Next : Next


For x = 1 To 10:riga = riga & _
FormatSpace(Format2(x),13,1) & "°" & FormatSpace(Format2(mrc(x,1)),16,1) & _
FormatSpace(Format2(mrc(x,2)),8,1) & FormatSpace(Format2(mrc(x,3)),8,1) & _
FormatSpace(Format2(mrc(x,4)),17,1) & FormatSpace(Format2(mrc(x,5)),8,1) & _
FormatSpace(Format2(mrc(x,6)),8,1): Scrivi riga:riga = "": Next : Scrivi


Call abbina(ini,fin,ms,mtr(1,1),r,c0)


For x = 1 To 10
If x < 10 Then dn(x,11) = totfrdn(x):dn(x,12) = totradn(x):dn(x,13) = totrsdn(x): _
fg(x,11) = totfrfg(x):fg(x,12) = totrafg(x):fg(x,13) = totrsfg(x)
cd(x,10) = totfrcd(x):cd(x,11) = totracd(x):cd(x,12) = totrscd(x): Next


Call righeu: Scrivi Chr(13) & "Decine cabalistiche x ambo" & Space(12) & "Fre." & Space(7) & _
"R.Att." & Space(6) & "R.Sto." & Space(5) & "Ciclo Eff.",1
For x = 1 To 9: For y = 1 To 10
If y < 10 Then riga = riga & Format2(dn(x,y)) & "." Else riga = riga & Format2(dn(x,y))
Next : Scrivi riga & Space(10) & Format2(dn(x,11)) & Space(10) & Format2(dn(x,12)) & _
Space(10) & Format2(dn(x,13)) & Space(10) & Left((c0/dn(x,11)),4)
riga = "": Next


Call righeu: Scrivi Chr(13) & "Cadenze x ambo" & Space(24) & "Fre." & Space(7) & _
"R.Att." & Space(6) & "R.Sto." & Space(5) & "Ciclo Eff.",1:
For x = 1 To 10: For y = 1 To 9
If y < 9 Then riga = riga & Format2(cd(x,y)) & "." Else riga = riga & Format2(cd(x,y))
Next : Scrivi riga & Space(13) & Format2(cd(x,10)) & Space(10) & Format2(cd(x,11)) & _
Space(10) & Format2(cd(x,12)) & Space(10) & Left((c0/cd(x,10)),4):
riga = "": Next


Call righeu: Scrivi Chr(13) & "Figure x ambo" & Space(25) & "Fre." & Space(7) & _
"R.Att." & Space(6) & "R.Sto." & Space(5) & "Ciclo Eff.",1: For x = 1 To 9: For y = 1 To 10
If y < 10 Then riga = riga & Format2(fg(x,y)) & "." Else riga = riga & Format2(fg(x,y))
Next : Scrivi riga & Space(10) & Format2(fg(x,11)) & Space(10) & Format2(fg(x,12)) & _
Space(10) & Format2(fg(x,13)) & Space(10) & Left((c0/fg(x,11)),4):
riga = "": Next


Call righeu: Scrivi Chr(13) & "Terzine simmetriche x ambo" & Chr(13) & Space(15) & "Fre." & _
Space(3) & "R.A." & Space(3) & "R.S." & Space(32) & "Fre." & Space(3) & "R.A." & Space(3) & "R.S." & Space(3),1
For x = 1 To 15: Scrivi Format2(x) & "." & Format2(x + 30) & "." & Format2(x + 60) & _
FormatSpace(CInt(datitrz(x,1)),10,1) & FormatSpace(CInt(datitrz(x,2)),7,1) & _
FormatSpace(CInt(datitrz(x,3)),7,1) & Space(18) & _
Format2(15 + x) & "." & Format2(15 + x + 30) & "." & Format2(15 + x + 60) & _
FormatSpace(CInt(datitrz(x,1)),10,1) & FormatSpace(CInt(datitrz(x,2)),7,1) & _
FormatSpace(CInt(datitrz(x,3)),7,1): Next


Call righeu: Scrivi Chr(13) & Space(18) & "Radicali x ambo" & Space(9) & "Fre." & Space(5) & _
"R.A." & Space(5) & "R.S.",1
For x = 1 To 8: rdl(1) = x:rdl(2) = x*10:rdl(3) = rdl(2) + x:rdl(4) = rdl(2) + 9
Scrivi String(18," ") & StringaNumeri(rdl) & FormatSpace(CInt(datirdl(x,1)),16,1) & _
FormatSpace(CInt(datirdl(x,2)),9,1) & FormatSpace(CInt(datirdl(x,3)),9,1): Next


Call righeu: Scrivi Chr(13) & Space(10) & "Gemelli x ambo" & Space(18) & "Fre." & Space(5) & _
"R.A." & Space(5) & "R.S.",1
Scrivi Space(10) & StringaNumeri(gem) & FormatSpace(CInt(datigem(1)),12,1) & _
FormatSpace(CInt(datigem(2)),9,1) & FormatSpace(CInt(datigem(3)),9,1)


Call righeu: Scrivi Chr(13) & "Vertibili x ambo" & Chr(13) & " Fre. R.A. R.S." & _
Space(17) & "Fre. R.A. R.S." & Space(17) & "Fre. R.A. R.S.",1: OrdinaMatrice dativrt,- 1,3
For x = 1 To 30: riga = riga & Format2(dativrt(x,1)) & "-" & Format2(dativrt(x,2))
If dativrt(x,3) > 0 Then riga = riga & FormatSpace(dativrt(x,3),5,1) Else riga = riga & " 0"
riga = riga & FormatSpace(dativrt(x,4),6,1) & FormatSpace(dativrt(x,5),6,1):riga = riga & Space(11)
riga = riga & Format2(dativrt(30 + x,1)) & "-" & Format2(dativrt(30 + x,2))
If dativrt(30 + x,3) > 0 Then riga = riga & FormatSpace(dativrt(30 + x,3),5,1) Else riga = riga & " 0"
riga = riga & FormatSpace(dativrt(30 + x,4),6,1) & FormatSpace(dativrt(30 + x,5),6,1)
riga = riga & Space(11):riga = riga & Format2(dativrt(60 + x,1)) & "-" & Format2(dativrt(60 + x,2))
If dativrt(60 + x,3) > 0 Then riga = riga & FormatSpace(dativrt(60 + x,3),5,1) Else riga = riga & " 0"
riga = riga & FormatSpace(dativrt(60 + x,4),6,1) & FormatSpace(dativrt(60 + x,5),6,1)
Scrivi riga:riga = "": Next


Call righeu: Scrivi Chr(13) & Space(33) & "STATISTICHE SUPERENALOTTO" & Chr(13) & Chr(13) & _
"Per un totale di " & c0 & " estrazioni in data " & "gg/" & MeseNome(ms) & "/aa sulla ruota di " & _
NomeRuota(r) & "." & Chr(13) & "Le presenze" & " ed i ritardi vengono rilevati all'ultima" & _
" estrazione del mese di " & MeseNome(ms) & Chr(13) & "presente in archivio" & Chr(13) & Chr(13) & _
"Frequenze per posizione",1


For y = 2 To 7:OrdinaMatrice nms,- 1,y
For x = 1 To 10:riga = riga & FormatSpace(Format2(nms(x,1)),5,1)
rige = rige & FormatSpace(Format2(nms(x,y)),5,1): Next
Scrivi y - 1 & "° " & "Pos: " & riga,1: ColoreTesto 1: Scrivi "Fre. : " & rige
ColoreTesto 0:riga = "":rige = "": Next


Scrivi Chr(13) & "Frequenze totali",1: OrdinaMatrice nms,- 1,8
For x = 1 To 15:riga = riga & FormatSpace(Format2(nms(x,1)),5,1)
rige = rige & FormatSpace(Format2(nms(x,8)),5,1): Next
Scrivi "Num. : " & riga,1: ColoreTesto 2: Scrivi "Pre. : " & rige
ColoreTesto 0: riga = "":rige = ""


Scrivi Chr(13) & "Ritardi Attuali totali",1: OrdinaMatrice nms,- 1,9
For x = 1 To 15:riga = riga & FormatSpace(Format2(nms(x,1)),5,1)
rige = rige & FormatSpace(Format2(nms(x,9)),5,1): Next
Scrivi "Num. : " & riga,1: ColoreTesto 2: Scrivi "Rit. : " & rige
ColoreTesto 0:riga = "":rige = ""


Scrivi Chr(13) & "Ritardi Storici totali",1: OrdinaMatrice nms,- 1,10
For x = 1 To 15:riga = riga & FormatSpace(Format2(nms(x,1)),5,1)
rige = rige & FormatSpace(Format2(nms(x,10)),5,1): Next
Scrivi "Num. : " & riga,1: ColoreTesto 2: Scrivi "Rit. : " & rige
ColoreTesto 0: riga = "":rige = ""
ColoreTesto 2: Scrivi Chr(13) & Space(78) & "listedrobyca",1: End Sub


Function abbina(ini,fin,ms,n,r,c0): Dim nu(90,2)
For x = 1 To 90:nu(x,1) = x:nu(x,2) = 0: Next
c1 = 0:
For es = ini To fin
If Mese(es) = ms And Posizione(es,r,n) > 0 Then
c1 = c1 + 1: ColoreTesto 2: Scrivi DataEstrazione(es) & " " & StringaEstratti(es,r)
For p = 1 To 5:nm = Estratto(es,r,p):nu(nm,2) = nu(nm,2) + 1: Next
End If : Next
OrdinaMatrice nu,- 1,2: For x = 1 To 20
If nu(x,2) > 0 And nu(x,1) <> n Then rig1 = rig1 & FormatSpace(Format2(nu(x,1)),4,1): _
rig2 = rig2 & FormatSpace(Format2(nu(x,2)),4,1)
Next : ColoreTesto 0: Scrivi Chr(13) & "Il numero " & n & " si è presentato " & c1 & " volta/e" & _
" in " & c0 & " estrazioni con data gg/" & MeseNome(ms) & "/aa," & Chr(13) & _
"Questi gli abbinameti: (max. 20)" & Chr(13) & Chr(13),1: ColoreTesto 1
If c1 = 0 Then rig1 = "":rig2 = ""
Scrivi "Numeri : " & rig1 & Chr(13) & "Frequenza: " & rig2,1:rig1 = "":rig2 = "": End Function


Sub righeu: ColoreTesto 1: Scrivi Chr(13) & String(90,"="),1: ColoreTesto 0: End Sub
Clicca per espandere...
 
Ultima modifica:
grazie Rabberto, Molto gentile.
Ho solo un problema facendo copia e incolla e cancellando i sub main e tuuto il resto delle scritte mi da errore
sbaglio io qualcosa
Grazie
 
Ciao Pattydreams64 non saprei a me con il copia e incolla il listato gira , riprova e fammi sapere , ciao.

 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    venerdì 20 giugno 2025
    Bari
    33
    01
    29
    44
    22
    Cagliari
    44
    19
    09
    33
    01
    Firenze
    68
    14
    30
    61
    05
    Genova
    44
    53
    24
    79
    62
    Milano
    62
    72
    07
    21
    37
    Napoli
    48
    39
    29
    85
    11
    Palermo
    12
    50
    29
    76
    75
    Roma
    89
    02
    62
    78
    23
    Torino
    16
    45
    27
    23
    13
    Venezia
    36
    77
    81
    09
    73
    Nazionale
    17
    18
    01
    47
    88
    Estrazione Simbolotto
    Napoli
    15
    35
    27
    25
    14
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto