Per Mike58

solare · 21 Febbraio 2018

Ciao Mike58, volevo chiederti sempre se puoi la modifica di questo tuo listato per il 10elotto serale

Sub Main()
Dim nua(4005,16),nn(2)
'ee = DataEstrToIdEstr (31,12,2009)

ee = InputBox("DA QUALE DATA INIZIARE"," DATA ","31/12/2009")
ms = CInt(InputBox("In quale mese? ",,1))
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
ResetTimer
'------------init tabella ------------------
ReDim atitoli(15)
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 2017 "
atitoli(13) = " Anno 2018 "
atitoli(14) = " Rit Sto "
atitoli(15) = " "
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)
rs = SerieStoricoTurbo(Ini,fin,nn,ru,1)
nua(co,4) = nua(co,4) + k
nua(co,5) = rt
nua(co,15) = rs
k1 = 0
If Anno(es) = 2016 Then k1 = SerieFreqTurbo(es,es,nn,ru,1)
nua(co,6) = nua(co,6) + k1
k2 = 0
If Anno(es) = 2015 Then k2 = SerieFreqTurbo(es,es,nn,ru,1)
nua(co,7) = nua(co,7) + k2
k3 = 0
If Anno(es) = 2014 Then k3 = SerieFreqTurbo(es,es,nn,ru,1)
nua(co,8) = nua(co,8) + k3
k4 = 0
If Anno(es) = 2013 Then k4 = SerieFreqTurbo(es,es,nn,ru,1)
nua(co,9) = nua(co,9) + k4
k5 = 0
If Anno(es) = 2012 Then k5 = SerieFreqTurbo(es,es,nn,ru,1)
nua(co,10) = nua(co,10) + k5
k6 = 0
If Anno(es) = 2011 Then k6 = SerieFreqTurbo(es,es,nn,ru,1)
nua(co,11) = nua(co,11) + k6
k7 = 0
If Anno(es) = 2010 Then k7 = SerieFreqTurbo(es,es,nn,ru,1)
nua(co,12) = nua(co,12) + k7
k8 = 0
If Anno(es) = 2017 Then k8 = SerieFreqTurbo(es,es,nn,ru,1)
nua(co,13) = nua(co,13) + k8
k9 = 0
If Anno(es) = 2018 Then k9 = SerieFreqTurbo(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(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(15)
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) = nua(z,15)
avalori(15) = " "
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 rit = 0 Then Call SetColoreCella(4,3,2)
If avalori(4) = 0 Then Call SetColoreCella(4,3,2)
Call SetColoreCella(1,1,0)
Call SetColoreCella(15,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)
k19 = k19 + avalori(13)
'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(15)
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 "Tempo di Elaborazione : " & TempoTrascorso
Scrivi " Tabella listed by Mike58 ",1,- 1,3
End Sub

Mike58 · 21 Febbraio 2018

Sempre e solo modifiche, un po' una stufita.
Se la voglia a molti è passata un motivo ci sarà.

Da ora in avanti sulle modifiche non interverrò più.

Ci vogliono idee che stimolano un po' la fantasia dello scripter.

Codice:

Sub Main()
ImpostaArchivio10ELotto(1)

Dim nua(90,16),nn(2)
'ee = DataEstrToIdEstr (31,12,2009)
'ee = InputBox("DA QUALE DATA INIZIARE"," DATA ","31/12/2009")
ms = CInt(InputBox("In quale mese? ",,1))
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)
Ini = 8163
fin = EstrazioniArchivioDL
ResetTimer
'------------init tabella ------------------
ReDim atitoli(15)
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 2017 "
atitoli(13) = " Anno 2018 "
atitoli(14) = " Rit Sto "
atitoli(15) = " "
Call InitTabella(atitoli,1,,3,5)
For es = Ini To fin
If MeseDL(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 = SerieFreqDL(es,es,nn,1)
rt = SerieRitardoDL(Ini,fin,nn,1)
rs = SerieStoricoDL(Ini,fin,nn,1)
nua(co,4) = nua(co,4) + k
nua(co,5) = rt
nua(co,15) = rs
k1 = 0
If AnnoDL(es) = 2016 Then k1 = SerieFreqDL(es,es,nn,1)
nua(co,6) = nua(co,6) + k1
k2 = 0
If AnnoDL(es) = 2015 Then k2 = SerieFreqDL(es,es,nn,1)
nua(co,7) = nua(co,7) + k2
k3 = 0
If AnnoDL(es) = 2014 Then k3 = SerieFreqDL(es,es,nn,1)
nua(co,8) = nua(co,8) + k3
k4 = 0
If AnnoDL(es) = 2013 Then k4 = SerieFreqDL(es,es,nn,1)
nua(co,9) = nua(co,9) + k4
k5 = 0
If AnnoDL(es) = 2012 Then k5 = SerieFreqDL(es,es,nn,1)
nua(co,10) = nua(co,10) + k5
k6 = 0
If AnnoDL(es) = 2011 Then k6 = SerieFreqDL(es,es,nn,1)
nua(co,11) = nua(co,11) + k6
k7 = 0
If AnnoDL(es) = 2010 Then k7 = SerieFreqDL(es,es,nn,1)
nua(co,12) = nua(co,12) + k7
k8 = 0
If AnnoDL(es) = 2017 Then k8 = SerieFreqDL(es,es,nn,1)
nua(co,13) = nua(co,13) + k8
k9 = 0
If AnnoDL(es) = 2018 Then k9 = SerieFreqDL(es,es,nn,1)
nua(co,14) = nua(co,14) + k9


Next
'Next
End If
Next
OrdinaMatrice nua,- 1,4
ColoreTesto 2
Scrivi Space(10) & "Dal " & ee & " al " & DataEstrazioneDL(fin),1
ColoreTesto 0
Scrivi "I " & q & " Numeri più frequenti " & " al 10 e Lotto Serale " & " nel mese di " & MeseNome(ms),1
Scrivi
For z = 1 To q
ReDim avalori(15)
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) = nua(z,15)
avalori(15) = " "
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 rit = 0 Then Call SetColoreCella(4,3,2)
If avalori(4) = 0 Then Call SetColoreCella(4,3,2)
Call SetColoreCella(1,1,0)
Call SetColoreCella(15,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)
k19 = k19 + avalori(13)
'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(15)
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 "Tempo di Elaborazione : " & TempoTrascorso
Scrivi " Tabella listed by Mike58 ",1,- 1,3
End Sub

solare · 21 Febbraio 2018

Ok grazie
Allora vorrà dire che se mi arriva qualche idea, posso disturbarti ?

solare · 2 Marzo 2018

Ciao qualcuno potrebbe provare questo listato, a me non funziona.
Grazie

solare · 2 Marzo 2018

risolto tutto installando nuovamente spaziometria

Cerca

Cerca

Per Mike58

solare

Advanced Member >PLATINUM<

Mike58

Advanced Member >PLATINUM PLUS<

solare

Advanced Member >PLATINUM<

solare

Advanced Member >PLATINUM<

solare

Advanced Member >PLATINUM<

Ultima estrazione Lotto

Ultimi Messaggi