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ì 22 agosto 2025
    Bari
    77
    43
    54
    27
    51
    Cagliari
    22
    61
    76
    27
    13
    Firenze
    75
    82
    78
    15
    80
    Genova
    18
    28
    60
    37
    50
    Milano
    84
    06
    90
    36
    40
    Napoli
    47
    09
    53
    65
    14
    Palermo
    74
    29
    40
    50
    30
    Roma
    79
    05
    15
    08
    26
    Torino
    03
    02
    60
    27
    26
    Venezia
    59
    14
    32
    70
    36
    Nazionale
    48
    09
    04
    88
    52
    Estrazione Simbolotto
    Nazionale
    07
    24
    42
    16
    03
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto