Frequenze Mensili

[lottomoney]

Buongiorno e buona domenica a tutti
ho fatto una ricerca nella sezione script ma non ho trovato nulla che potesse aiutarmi.
Stavo cercando, se possibile, uno script per la ricerca MENSILE dei numeri più frequenti in un determinato mese a scelta e, sempre se possibile, retrodatando la ricerca a 10 anni sempre per lo stesso mese cercare i numeri più frequenti, suddividendoli anche ruota per ruota.
Grazie anticipate per chi ha la pazienza e sopratutto la voglia.
lottomoney

[lottomoney]

Buonasera, mi sono accorto di aver già formulato tale riciesta e di avere avuto una risposta con questo script:

Sub Main()
Dim nua(4005,13),nn(2)
ee = InputBox("DA QUALE DATA INIZIARE"," DATA ","31/12/2008")
ms = CInt(InputBox("In quale mese? ",,5))
If ms = "" Then Exit Sub
'r = CInt(InputBox("Di quale ruota? ",,5))
'If r = "" Then Exit Sub
'ru(1) = r
q = CInt(InputBox("Quanti ambi ed estratti vuoi visualizzare ? ",,20))
If q = "" Then Exit Sub
'
ReDim ru(0)
r = ScegliRuote(ru)
fin = EstrazioneFin
'------------init tabella ------------------
ReDim atitoli(13)
atitoli(1) = " "
atitoli(2) = " Numero "
atitoli(3) = " Frequenza "
atitoli(4) = " Ritardo Attuale "
atitoli(5) = " Anno_2016 "
atitoli(6) = " Anno_2015 "
atitoli(7) = " Anno 2014 "
atitoli(8) = " Anno 2013 "
atitoli(9) = " Anno 2012 "
atitoli(10) = " Anno 2011 "
atitoli(11) = " Anno 2010 "
atitoli(12) = " Anno 2009 "
atitoli(13) = " "
Call InitTabella(atitoli,1,,3,5)
For es = PrimaSuccessiva(ee) To fin
If Mese(es) = ms Then
co = 0
'For x = 1 To 89
'x = cg
'For y = x + 1 To 90
For x = 1 To 90
'If x <> y Then
co = co + 1
nua(co,1) = co
nua(co,2) = x
'nua(co,3) = y
nn(1) = x
'nn(2) = y
k = SerieFreqTurbo(es,es,nn,ru,1)
rt = SerieRitardoTurbo(Ini,fin,nn,ru,1)
nua(co,4) = nua(co,4) + k
nua(co,5) = rt
k1 = 0
If Anno(es) = 2016 Then k1 = SerieFreq(es,es,nn,ru,1)
nua(co,6) = nua(co,6) + k1
k2 = 0
If Anno(es) = 2015 Then k2 = SerieFreq(es,es,nn,ru,1)
nua(co,7) = nua(co,7) + k2
k3 = 0
If Anno(es) = 2014 Then k3 = SerieFreq(es,es,nn,ru,1)
nua(co,8) = nua(co,8) + k3
k4 = 0
If Anno(es) = 2013 Then k4 = SerieFreq(es,es,nn,ru,1)
nua(co,9) = nua(co,9) + k4
k5 = 0
If Anno(es) = 2012 Then k5 = SerieFreq(es,es,nn,ru,1)
nua(co,10) = nua(co,10) + k5
k6 = 0
If Anno(es) = 2011 Then k6 = SerieFreq(es,es,nn,ru,1)
nua(co,11) = nua(co,11) + k6
k7 = 0
If Anno(es) = 2010 Then k7 = SerieFreq(es,es,nn,ru,1)
nua(co,12) = nua(co,12) + k7
k8 = 0
If Anno(es) = 2009 Then k8 = SerieFreq(es,es,nn,ru,1)
nua(co,13) = nua(co,13) + k8
Next
'Next
End If
Next
OrdinaMatrice nua,- 1,4
ColoreTesto 2
Scrivi Space(10) & "Dal " & ee & " al " & DataEstrazione(fin),1
ColoreTesto 0
Scrivi "I " & q & " Numeri più frequenti " & " a " & StringaRuote(ru) & " nel mese di " & MeseNome(ms),1
Scrivi
For z = 1 To q
ReDim avalori(13)
avalori(1) = " "
avalori(2) = nua(z,2)
avalori(3) = nua(z,4)
avalori(4) = nua(z,5)
avalori(5) = nua(z,6)
avalori(6) = nua(z,7)
avalori(7) = nua(z,8)
avalori(8) = nua(z,9)
avalori(9) = nua(z,10)
avalori(10) = nua(z,11)
avalori(11) = nua(z,12)
avalori(12) = nua(z,13)
avalori(13) = " "
Call AddRigaTabella(avalori,,,3)
For xx = 5 To 12
Call SetColoreCella((xx),4,1)
If avalori(5) > 0 And avalori(6) > 0 And avalori(7) > 0 And avalori(8) > 0 And avalori(9) > 0 And avalori(10) > 0 And avalori(11) > 0 And avalori(12) > 0 Then
Call SetColoreCella((xx),6,1)
Call SetColoreCella(2,6,1)
End If
Next
'If avalori(5) = 0 And avalori(6) > 0 And avalori(7) > 0 And avalori(8) > 0 And avalori(9) > 0 Then Call SetColoreCella(2,vbGreen)
'If avalori(5) > 0 Then Call SetColoreCella(2,2,4)
If avalori(5) = 0 Then Call SetColoreCella(2,3,1)
If avalori(4) = 0 Then Call SetColoreCella(4,3,2)
Call SetColoreCella(1,1,0)
Call SetColoreCella(13,1,0)
k11 = k11 + avalori(5)
k12 = k12 + avalori(6)
k13 = k13 + avalori(7)
k14 = k14 + avalori(8)
k15 = k15 + avalori(9)
k16 = k16 + avalori(10)
k17 = k17 + avalori(11)
k18 = k18 + avalori(12)
'riga = Format2(nua(z,2)) & "-" & Format2(nua(z,3)) & Space(3) & Format2(nua(z,4)) & Space(10) & Format2(nua(z,5))
'Scrivi Space(10) & riga,1
'riga = ""
Next
ReDim avalori1(13)
avalori1(1) = " "
avalori1(5) = k11
avalori1(6) = k12
avalori1(7) = k13
avalori1(8) = k14
avalori1(9) = k15
avalori1(10) = k16
avalori1(11) = k17
avalori1(12) = k18
'avalori1(13) = k19
Call AddRigaTabella(avalori1,1,,3,5)
Call SetTableWidth("100%")
Call CreaTabella()
Scrivi " Tabella listed by Mike58 ",1,- 1,3
End Sub

Volevo sapere se è possibile farlo girare anche su L8+ perchè provandolo risulterebbero degli errori (su L8+).
Inoltre, anche su Spaziometria, se ci fosse la possibilità del calcolo anche nell'anno attuale.
Grazie.
lottomoney

[Master]

Ciao lottomoney
vacanze finite
Ho modificato gli script...spero senza errori


Script per L8

Codice: Seleziona tutto

 Sub Main()
   Dim nua(4005,14),nn(2),ru(1)
   ee = InputBox("DA QUALE DATA INIZIARE"," DATA ","31/12/2008")
   r = InputBox("Di quale ruota? "," RUOTA ",1)
   ms = CInt(InputBox("In quale mese? "," MESE ",5))
   If ms = "" Then Exit Sub
   q = CInt(InputBox("Quanti ambi ed estratti vuoi visualizzare ? "," QUANTI ",20))
   If q = "" Then Exit Sub
   ru(1) = r
   ini = EstrazioneIni
   fin = EstrazioneFin
   For es = PrimaSuccessiva(ee) To fin
      If Mese(es) = ms Then
         co = 0
         For x = 1 To 90
            co = co + 1
            nua(co,1) = co
            nua(co,2) = x
            nn(1) = x
            k = SerieFreq(es,es,nn,ru,1)
            rt = SerieRitardo(Ini,fin,nn,ru,1)
            nua(co,4) = nua(co,4) + k
            nua(co,5) = rt
            k1 = 0
            If Anno(es) = 2017 Then k1 = SerieFreq(es,es,nn,ru,1)
            nua(co,6) = nua(co,6) + k1
            k2 = 0
            If Anno(es) = 2016 Then k2 = SerieFreq(es,es,nn,ru,1)
            nua(co,7) = nua(co,7) + k2
            k3 = 0
            If Anno(es) = 2015 Then k3 = SerieFreq(es,es,nn,ru,1)
            nua(co,8) = nua(co,8) + k3
            k4 = 0
            If Anno(es) = 2014 Then k4 = SerieFreq(es,es,nn,ru,1)
            nua(co,9) = nua(co,9) + k4
            k5 = 0
            If Anno(es) = 2013 Then k5 = SerieFreq(es,es,nn,ru,1)
            nua(co,10) = nua(co,10) + k5
            k6 = 0
            If Anno(es) = 2012 Then k6 = SerieFreq(es,es,nn,ru,1)
            nua(co,11) = nua(co,11) + k6
            k7 = 0
            If Anno(es) = 2011 Then k7 = SerieFreq(es,es,nn,ru,1)
            nua(co,12) = nua(co,12) + k7
            k8 = 0
            If Anno(es) = 2010 Then k8 = SerieFreq(es,es,nn,ru,1)
            nua(co,13) = nua(co,13) + k8
            k9 = 0
            If Anno(es) = 2009 Then k9 = SerieFreq(es,es,nn,ru,1)
            nua(co,14) = nua(co,14) + k9
         Next
         'Next
      End If
   Next
   OrdinaMatrice nua,- 1,4
   ColoreTesto 2
   Scrivi Space(26) & "Dal " & ee & " al " & DataEstrazione(fin),1
   ColoreTesto 0
   Scrivi Space(12) & "I " & q & " Numeri più frequenti " & " a " & NomeRuota(ru(1)) & " nel mese di " & MeseNome(ms),1
   Scrivi:Scrivi
   Scrivi vbTab & "Nr" & vbTab & "Freq" & vbTab & "R/A" & vbTab & "2017" & vbTab & "2016" & vbTab & "2015" & vbTab & _
   "2014" & vbTab & "2013" & vbTab & "2012" & vbTab & "2011" & vbTab & "2010" & vbTab & "2009 ",1'  & vbTab &
   For z = 1 To q
      Scrivi
      Scrivi vbTab & nua(z,2) & vbTab & nua(z,4) & vbTab & nua(z,5) & vbTab & nua(z,6) & vbTab & nua(z,7) & vbTab & nua(z,8) & vbTab & _
      nua(z,9) & vbTab & nua(z,10) & vbTab & nua(z,11) & vbTab & nua(z,12) & vbTab & nua(z,13) & vbTab & nua(z,14) '   & vbTab &
   Next
End Sub


Script con il 2017

Codice: Seleziona tutto

 Sub Main()
   Dim nua(4005,14),nn(2)
   ee = InputBox("DA QUALE DATA INIZIARE"," DATA ","31/12/2008")
   ms = CInt(InputBox("In quale mese? ",,5))
   If ms = "" Then Exit Sub
   q = CInt(InputBox("Quanti ambi ed estratti vuoi visualizzare ? ",,20))
   If q = "" Then Exit Sub
   ReDim ru(0)
   r = ScegliRuote(ru)
   fin = EstrazioneFin
   '------------init tabella ------------------
   ReDim atitoli(14)
   atitoli(1) = " "
   atitoli(2) = " Numero "
   atitoli(3) = " Frequenza "
   atitoli(4) = " Ritardo Attuale "
   atitoli(5) = " Anno_2017 "
   atitoli(6) = " Anno_2016 "
   atitoli(7) = " Anno_2015 "
   atitoli(8) = " Anno 2014 "
   atitoli(9) = " Anno 2013 "
   atitoli(10) = " Anno 2012 "
   atitoli(11) = " Anno 2011 "
   atitoli(12) = " Anno 2010 "
   atitoli(13) = " Anno 2009 "
   atitoli(14) = " "
   Call InitTabella(atitoli,1,,3,5)
   For es = PrimaSuccessiva(ee) To fin
      If Mese(es) = ms Then
         co = 0
         For x = 1 To 90
            co = co + 1
            nua(co,1) = co
            nua(co,2) = x
            nn(1) = x
            k = SerieFreqTurbo(es,es,nn,ru,1)
            rt = SerieRitardoTurbo(Ini,fin,nn,ru,1)
            nua(co,4) = nua(co,4) + k
            nua(co,5) = rt
            k1 = 0
            If Anno(es) = 2017 Then k1 = SerieFreq(es,es,nn,ru,1)
            nua(co,6) = nua(co,6) + k1
            k2 = 0
            If Anno(es) = 2016 Then k2 = SerieFreq(es,es,nn,ru,1)
            nua(co,7) = nua(co,7) + k2
            k3 = 0
            If Anno(es) = 2015 Then k3 = SerieFreq(es,es,nn,ru,1)
            nua(co,8) = nua(co,8) + k3
            k4 = 0
            If Anno(es) = 2014 Then k4 = SerieFreq(es,es,nn,ru,1)
            nua(co,9) = nua(co,9) + k4
            k5 = 0
            If Anno(es) = 2013 Then k5 = SerieFreq(es,es,nn,ru,1)
            nua(co,10) = nua(co,10) + k5
            k6 = 0
            If Anno(es) = 2012 Then k6 = SerieFreq(es,es,nn,ru,1)
            nua(co,11) = nua(co,11) + k6
            k7 = 0
            If Anno(es) = 2011 Then k7 = SerieFreq(es,es,nn,ru,1)
            nua(co,12) = nua(co,12) + k7
            k8 = 0
            If Anno(es) = 2010 Then k8 = SerieFreq(es,es,nn,ru,1)
            nua(co,13) = nua(co,13) + k8
            k9 = 0
            If Anno(es) = 2009 Then k9 = SerieFreq(es,es,nn,ru,1)
            nua(co,14) = nua(co,14) + k9
         Next
      End If
   Next
   OrdinaMatrice nua,- 1,4
   ColoreTesto 2
   Scrivi Space(10) & "Dal " & ee & " al " & DataEstrazione(fin),1
   ColoreTesto 0
   Scrivi "I " & q & " Numeri più frequenti " & " a " & StringaRuote(ru) & " nel mese di " & MeseNome(ms),1
   Scrivi
   For z = 1 To q
      ReDim avalori(14)
      avalori(1) = " "
      avalori(2) = nua(z,2)
      avalori(3) = nua(z,4)
      avalori(4) = nua(z,5)
      avalori(5) = nua(z,6)
      avalori(6) = nua(z,7)
      avalori(7) = nua(z,8)
      avalori(8) = nua(z,9)
      avalori(9) = nua(z,10)
      avalori(10) = nua(z,11)
      avalori(11) = nua(z,12)
      avalori(12) = nua(z,13)
      avalori(13) = nua(z,14)
      avalori(14) = " "
      Call AddRigaTabella(avalori,,,3)
      For xx = 5 To 13
         Call SetColoreCella((xx),4,1)
         If avalori(5) > 0 And avalori(6) > 0 And avalori(7) > 0 And avalori(8) > 0 And avalori(9) > 0 And avalori(10) > 0 And avalori(11) > 0 And avalori(12) > 0 And avalori(13) > 0 Then
            Call SetColoreCella((xx),6,1)
            Call SetColoreCella(2,6,1)
         End If
      Next
      If avalori(5) = 0 Then Call SetColoreCella(2,3,1)
      If avalori(4) = 0 Then Call SetColoreCella(4,3,2)
      Call SetColoreCella(1,1,0)
      Call SetColoreCella(14,1,0)
      k11 = k11 + avalori(5)
      k12 = k12 + avalori(6)
      k13 = k13 + avalori(7)
      k14 = k14 + avalori(8)
      k15 = k15 + avalori(9)
      k16 = k16 + avalori(10)
      k17 = k17 + avalori(11)
      k18 = k18 + avalori(12)
   Next
   ReDim avalori1(14)
   avalori1(1) = " "
   avalori1(5) = k11
   avalori1(6) = k12
   avalori1(7) = k13
   avalori1(8) = k14
   avalori1(9) = k15
   avalori1(10) = k16
   avalori1(11) = k17
   avalori1(12) = k18
   avalori1(13) = k19
   avalori1(14) = k20
   Call AddRigaTabella(avalori1,1,,3,5)
   Call SetTableWidth("100%")
   Call CreaTabella()
   Scrivi " Tabella listed by Mike58 ",1,- 1,3
   Scrivi" aggiunto 2017 by Master"
End Sub
 

[lottomoney]

Sei un grande Master. Complimenti.
Sarebbe interessante poterlo avere dall'inizio archivio del 1939.
Nel caso degli anni a seguire, senza doverti disturbare per la modifica, posso farla anch'io?
Se si, mi spieghi come? Grazie mille ancora.
lottomoney