Modifica Script "Del Bravo Mike58"

[Xeroxs]

Buongiorno a Tutti, Ho avuto tra le mani questo Ottimo script del Bravo Mike58 e mi sono permesso di correggerlo aggiornando gli anni a quelli più attuali in quanto non sapevo come aggiungere gli anni mancanti così ho pensato a delle semplici modifiche,
Volevo chiedere se è fattibile la modifica fatta non solo sulla Frequenza ma soprattutto sulla copertura degli estratti, per affinare meglio la scelta degli eventuali numeri per le future giocate,

A Esempio la ricerca su Torino nel mese di luglio Riporta come numero frequente il 30 frequente 11 volte ma con una copertura dal 2102 di 6 cicli o mesi su 8.

Mentre il 46 come il 56 ed il 17 hanno una copertura pari a 7 cicli su 8,

Ciò che mi piacerebbe senza sconvolgere questo ottimo listato aggiungere appunto la maggior copertura degli estratti che si sono presentati

Allego il listato.


Sub Main()
Dim ru(1),nua(4005,13),nn(2)
ee = InputBox("DA QUALE DATA INIZIARE"," DATA ","31/12/2011")
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
'
fin = EstrazioneFin
'------------init tabella ------------------
ReDim atitoli(13)
atitoli(1) = " "
atitoli(2) = " Numero "
atitoli(3) = " Frequenza "
atitoli(4) = " Ritardo Attuale "
atitoli(5) = " Anno_2019 "
atitoli(6) = " Anno_2018 "
atitoli(7) = " Anno 2017 "
atitoli(8) = " Anno 2016 "
atitoli(9) = " Anno 2015 "
atitoli(10) = " Anno 2014 "
atitoli(11) = " Anno 2013 "
atitoli(12) = " Anno 2012 "
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) = 2019 Then k1 = SerieFreq(es,es,nn,ru,1)
nua(co,6) = nua(co,6) + k1
k2 = 0
If Anno(es) = 2018 Then k2 = SerieFreq(es,es,nn,ru,1)
nua(co,7) = nua(co,7) + k2
k3 = 0
If Anno(es) = 2017 Then k3 = SerieFreq(es,es,nn,ru,1)
nua(co,8) = nua(co,8) + k3
k4 = 0
If Anno(es) = 2016 Then k4 = SerieFreq(es,es,nn,ru,1)
nua(co,9) = nua(co,9) + k4
k5 = 0
If Anno(es) = 2015 Then k5 = SerieFreq(es,es,nn,ru,1)
nua(co,10) = nua(co,10) + k5
k6 = 0
If Anno(es) = 2014 Then k6 = SerieFreq(es,es,nn,ru,1)
nua(co,11) = nua(co,11) + k6
k7 = 0
If Anno(es) = 2013 Then k7 = SerieFreq(es,es,nn,ru,1)
nua(co,12) = nua(co,12) + k7
k8 = 0
If Anno(es) = 2012 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 " & NomeRuota(r) & " 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


Grazie come sempre

 

[Mike58]

Xeroxs, il listato con le correzione sembra sia esattamente modificato in tutte le sue parti di codici e di conteggio.
Non ti rimane che aggiungere l'anno 2020 con i relativi conteggi.

è giusto che impariate almeno a modificare per i vostri scopi.
Lo script datato era rigido nella sua stesura.

Ciao

 

[Xeroxs]

Grazie Mike, proverò.