X MIKE58 o scripter di buona volontà-grazie sin d'ora

Codicebinario · 6 Dicembre 2023

Questo script e' di Mike58,premetto,(come tutti sapranno che sono un pippone sugli script) che la questione è:

pur facendolo girare correttamente,trova solo gli estratti nel periodo indicato,ma non mi fa' vedere gli ambi...qual'è il parametro da cambiare per visualizzare anche gli ambi?(ammesso e non concesso che sia solo un "parametro"....)Questo script,che e' firmato,l'ho' ritrovato fra le mie innumerevoli chiavette dedicate al lotto,mi ha' incuriosito,ma non riesco a modificarlo per vedere ,a scelta ,gli ambi o solo gli estratti,oppure insieme in due distinte tabelle....Scusate , ma non sono capace....alllego lo script....

Sub Main()
Dim nua(4005,14),nn(2)
ee = InputBox("DA QUALE DATA INIZIARE"," DATA ","15/09/2009")
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_2023 "
atitoli(6) = " Anno_2022 "
atitoli(7) = " Anno_2021 "
atitoli(8) = " Anno 2020 "
atitoli(9) = " Anno 2019 "
atitoli(10) = " Anno 2018 "
atitoli(11) = " Anno 2017 "
atitoli(12) = " Anno 2016 "
atitoli(13) = " Anno 2015 "
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) = 2023 Then k1 = SerieFreq(es,es,nn,ru,1)
nua(co,6) = nua(co,6) + k1
k2 = 0
If Anno(es) = 2022Then k2 = SerieFreq(es,es,nn,ru,1)
nua(co,7) = nua(co,7) + k2
k3 = 0
If Anno(es) = 2021 Then k3 = SerieFreq(es,es,nn,ru,1)
nua(co,8) = nua(co,8) + k3
k4 = 0
If Anno(es) = 2020 Then k4 = SerieFreq(es,es,nn,ru,1)
nua(co,9) = nua(co,9) + k4
k5 = 0
If Anno(es) = 2019 Then k5 = SerieFreq(es,es,nn,ru,1)
nua(co,10) = nua(co,10) + k5
k6 = 0
If Anno(es) = 2018 Then k6 = SerieFreq(es,es,nn,ru,1)
nua(co,11) = nua(co,11) + k6
k7 = 0
If Anno(es) = 2017 Then k7 = SerieFreq(es,es,nn,ru,1)
nua(co,12) = nua(co,12) + k7
k8 = 0
If Anno(es) = 2016 Then k8 = SerieFreq(es,es,nn,ru,1)
nua(co,13) = nua(co,13) + k8
k9 = 0
If Anno(es) = 2015 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

End Sub

Grazie a tutti !!!!!

Mike58 · 6 Dicembre 2023

Non Mi Piace + rimodellare , correggere , scompigliare script .
Comunque bastava un nuovo ciclo for e immettere la sorte di esito nella serieFrequenza.

Codice:

Sub Main()
   Dim nua(4005,14),nn(2)
   ee = InputBox("DA QUALE DATA INIZIARE"," DATA ","15/09/2009")
   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
   ss = CInt(InputBox("Quale sorte di esito",,2))
   ResetTimer
   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_2023 "
   atitoli(6) = " Anno_2022 "
   atitoli(7) = " Anno_2021 "
   atitoli(8) = " Anno 2020 "
   atitoli(9) = " Anno 2019 "
   atitoli(10) = " Anno 2018 "
   atitoli(11) = " Anno 2017 "
   atitoli(12) = " Anno 2016 "
   atitoli(13) = " Anno 2015 "
   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 89
            For y = x + 1 To 90
               co = co + 1
               nua(co,1) = co
               nua(co,2) = x & "." & y
               nn(1) = x
               nn(2) = y
               k = SerieFreqTurbo(es,es,nn,ru,ss)
               rt = SerieRitardoTurbo(Ini,fin,nn,ru,ss)
               nua(co,4) = nua(co,4) + k
               nua(co,5) = rt
               k1 = 0
               If Anno(es) = 2023 Then k1 = SerieFreq(es,es,nn,ru,ss)
               nua(co,6) = nua(co,6) + k1
               k2 = 0
               If Anno(es) = 2022Then k2 = SerieFreq(es,es,nn,ru,ss)
               nua(co,7) = nua(co,7) + k2
               k3 = 0
               If Anno(es) = 2021 Then k3 = SerieFreq(es,es,nn,ru,ss)
               nua(co,8) = nua(co,8) + k3
               k4 = 0
               If Anno(es) = 2020 Then k4 = SerieFreq(es,es,nn,ru,ss)
               nua(co,9) = nua(co,9) + k4
               k5 = 0
               If Anno(es) = 2019 Then k5 = SerieFreq(es,es,nn,ru,ss)
               nua(co,10) = nua(co,10) + k5
               k6 = 0
               If Anno(es) = 2018 Then k6 = SerieFreq(es,es,nn,ru,ss)
               nua(co,11) = nua(co,11) + k6
               k7 = 0
               If Anno(es) = 2017 Then k7 = SerieFreq(es,es,nn,ru,ss)
               nua(co,12) = nua(co,12) + k7
               k8 = 0
               If Anno(es) = 2016 Then k8 = SerieFreq(es,es,nn,ru,ss)
               nua(co,13) = nua(co,13) + k8
               k9 = 0
               If Anno(es) = 2015 Then k9 = SerieFreq(es,es,nn,ru,ss)
               nua(co,14) = nua(co,14) + k9
               '
              
            Next
         Next
         Call Messaggio("Trovati. . . .  " & es & Space(20) & TempoTrascorso)
               Call AvanzamentoElab(Ini,fin,es)
      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 "Sorte di Esito : " & NomeSorte(ss),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 list by Mike58 ",1,- 1,3
   Scrivi "Tempo di Elaborazione : " & TempoTrascorso,1
End Sub

ciao

Codicebinario · 6 Dicembre 2023

Grazie Mike58
non volevo disturbarti per queste"quisquiglie e pinzillacchere" scusami se ho' disturbato...mi sono permesso solo perche lo scipt ritrovato in chiavette mi ha' incuriosito,,,,era a tua firma e ho' chiesto a te in primis...mi sembrava doveroso e ossequioso...scusami.e grazie ancora,non sono una cima con gli script...sò fare poco...e non ci arrivo chiedo.scusa ancora per il disturbo.Grazie ancora.

Mike58 · 6 Dicembre 2023

Non Ti preoccupare non era rivolto a te direttamente , e solo che vedere script con costrutto datato la voglia in primis per capire la logica itinerante risulta a volte poco coinvolgente.
Quelli sono script con un mio bagaglio script più limitato che con il tempo un pochetto si è evoluto.
Comunque spero vada bene.
Ciao

Codicebinario · 6 Dicembre 2023

Grazie mike58,va benissimo ....e scusami ancora.Devo dire che la ricerca ,seppur datata,e' ottima...sarebbe bello addentrarsi sulla stessa ricerca con parametri diversi..ma questo e' altro discorso,grazie e ciao.

Cerca

Cerca

X MIKE58 o scripter di buona volontà-grazie sin d'ora

Codicebinario

Advanced Member >PLATINUM<

Mike58

Advanced Member >PLATINUM PLUS<

Codicebinario

Advanced Member >PLATINUM<

Mike58

Advanced Member >PLATINUM PLUS<

Codicebinario

Advanced Member >PLATINUM<

Ultima estrazione Lotto

Ultimi Messaggi