Richiesta modifica listato periodico di mike58

[solare]

Ciao, chiedo se possibile, avere un listato che trovi nel mese selezionato i numeri sortiti sempre negli anni indicati "Ultimi 3/4/5 ecc." con la possibilità di selezionare la quantità delle ruote.
Grazie infinite

 

[solare]

Ciao, non so chi ha compilato questo ma è molto vicino a quello che ho chiesto.
Chiedo se possibile aggiungere il ritardo storico e la possibilità di elaborare gli anni che si vuole.
nello stato attuale il listato chiede l'anno di partenza ma qualunque data si inserisce parte sempre dal 2009.

Sub Main()
Dim nua(4005,13),nn(2)
ee = InputBox("DA QUALE DATA INIZIARE"," DATA ","31/12/2009")
ms = CInt(InputBox("In quale mese? ",,11))
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 ? ",,5))
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%")
CreaTabellaOrdinabile()
Scrivi " Tabella listed by Mike58 ",1,- 1,3
End Sub

 

[trivellatomariotretre33]

Ciao Solare lo script e di Mike58 sicuramente lui potra darti piu di quello che chiedi e mostruosamente bravo con le tabelle e listati .

 

[Mike58]

Solare lo script in questione è costruito con rigidità in quanto gli if then dell'anno sono dichiarati e condizionati con gli if-then, pertanto la data deve essere rigida così e non va cambiata, pena il mal funzionamento, anche se penso che gli ultimi 8 anni rappresentano una buona statistica.

Ti ho messo tuttavia anche l'anno 2018 ed il ritardo storico (anche se in questo caso non saprei quale indicazione possa avere)

comunque ecco lo script.

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

 

[solare]

ciao Mike58, Ok grazie infinite
Per quanto riguarda il ritardo, si può sembrare insignificante se preso in considerazione per ritardo generale.
Quello che in tendevo io era avere il ritardo mi e max delle ultime sortite rappresentate nella tabella. Es. le ultime 6 7 volte che era sortito qual'era il ritardo mi e quello max ?
Forse in questo modo avrebbe avuto un significato utile, secondo il mio modesto parere.
Comunque grazie lo stesso per quello che fai.

 

[Mike58]

Solare, adesso ho capito cosa intentevi, ma in questo caso è stato fatto il conteggio di frequenza x mese e stabilire in quel mese e in quell'anno l'elenco ritardi in questo script risulta complicato.

mi spiace ma va usato così oppure con qualche altro script che analizza l'elenco ritardi valutare il numero in esame.
Ciao

 

[solare]

Ok grazie ugualmente
sei fin troppo gentile
Buona serata

 

[claudio8]

Da studiare : 'rileva x anno e mese freq rit,ecc. sino a terno

' Di Luigi B
'rileva x anno e mese freq rit,ecc.  sino a terno
Option Explicit
Sub Main
    Dim nTipoRicerca
    Dim nAnnoRicerca
    Dim nClasse
    Dim r,m
    Dim nRetRit,nRetRitMax,nRetFre,nStart,nEnd,nValore,nMaxRisultati,nCols
    ReDim aR(1)
    nTipoRicerca = TipoRicerca
    nAnnoRicerca = ScegliAnno
    nClasse = ScegliClasse
    nMaxRisultati = CInt(InputBox("Quanti elementi scegliere come primi della lista ? ","Quantita combinazioni",10))
    ReDim aNum(0)
    Call GetANumeriPerSvil(aNum)
    ReDim aCol(nClasse)
    If nAnnoRicerca = 0 Then Exit Sub
    If nMaxRisultati <= 0 Then Exit Sub
    Dim aTitoli
    aTitoli = Array("","Ruota","Mese","Numeri","Ritardo","RitardoMax","Frequenza")
    Call InitTabella(aTitoli)
    For m = 1 To 12
        If GetLimitiMese(m,nAnnoRicerca,nStart,nEnd) Then
            For r = 1 To 12
                If r <> 11 Then
                    ReDim aValMax(nMaxRisultati,3)
                    aR(1) = r
                    nCols = 0
                    Call InitSviluppoIntegrale(aNum,nClasse)
                    Do Until GetCombSviluppo(aCol) = False
                        Call StatisticaFormazioneTurbo(aCol,aR,nClasse,nRetRit,nRetRitMax,0,nRetFre,nStart,nEnd)
                        If nTipoRicerca = 0 Then
                            nValore = nRetRit
                            Call AggiungiAValoriMax(aCol,nValore,aValMax,nRetRit,nRetRitMax,nRetFre,nMaxRisultati,1)
                        ElseIf nTipoRicerca = 1 Then
                            nValore = nRetRitMax
                            Call AggiungiAValoriMax(aCol,nValore,aValMax,nRetRit,nRetRitMax,nRetFre,nMaxRisultati,2)
                        ElseIf nTipoRicerca = 2 Then
                            nValore = nRetFre
                            Call AggiungiAValoriMax(aCol,nValore,aValMax,nRetRit,nRetRitMax,nRetFre,nMaxRisultati,3)
                        End If
                        nCols = nCols + 1
                        If nCols Mod 100 = 0 Then
                            Messaggio("Analizzate colonne : " & nCols)
                            If ScriptInterrotto Then Exit Do
                        End If
                    Loop
                    Call AggiungiRigheTabella(aValMax,nMaxRisultati,NomeRuota(r),MeseNome(m),nTipoRicerca + 4)
                End If
            Next
        End If
        Call AvanzamentoElab(1,12,m)
        If ScriptInterrotto Then Exit For
    Next
    Call CreaTabella
End Sub
Function ScegliAnno()
    Dim nA,nB,nAnno
    nA = Anno(1)
    nB = Anno(EstrazioniArchivio)
    nAnno = CInt(InputBox("Inserire un anno da " & nA & " a " & nB,"Scelta anno",nA))
    If nAnno >= nA And nAnno <= nB Then
        ScegliAnno = nAnno
    Else
        ScegliAnno = 0
    End If
End Function
Function TipoRicerca()
    Dim aV
    aV = Array("Ritardo","RitardoMax","Frequenza")
    TipoRicerca = ScegliOpzioneMenu(aV,2)
End Function
Function ScegliClasse()
    Dim aV
    aV = Array("Estratto","Ambo","Terno")
    ScegliClasse = ScegliOpzioneMenu(aV,0) + 1
End Function
Function GetLimitiMese(nMese,nAnno,nRetIni,nRetFi)
    Dim g,id
    nRetIni = 0
    nRetFi = 0
    Do
        g = g + 1
        id = DataEstrToIdEstr(g,nMese,nAnno)
    Loop While id = 0 And g <= 30
    If id > 0 Then nRetIni = id
    g = 32
    Do
        g = g - 1
        id = DataEstrToIdEstr(g,nMese,nAnno)
    Loop While id = 0 And g > 0
    If id > 0 Then nRetFi = id
    If nRetIni And nRetFi > 0 Then
        GetLimitiMese = True
    Else
        GetLimitiMese = False
    End If
End Function
Sub AggiungiAValoriMax(aCol,nValore,aValMax,nRit,nRitMax,nFre,nMaxElementi,nIdValue)
    Dim k,j
    For k = 1 To nMaxElementi
        If nValore >= aValMax(k,nIdValue) Then
            For j = nMaxElementi To k + 1 Step - 1
                aValMax(j,0) = aValMax(j - 1,0)
                aValMax(j,1) = aValMax(j - 1,1)
                aValMax(j,2) = aValMax(j - 1,2)
                aValMax(j,3) = aValMax(j - 1,3)
            Next
            aValMax(k,0) = StringaNumeri(aCol)
            aValMax(k,1) = nRit
            aValMax(k,2) = nRitMax
            aValMax(k,3) = nFre
            Exit For
        End If
    Next
End Sub
Sub AggiungiRigheTabella(aValMax,nMaxRisultati,sRuota,sMese,nIdColValore)
    ReDim aV(7)
    Dim k,j
    ReDim aColori(7)
    For k = 0 To 7
        aColori(k) = vbBlack
    Next
    aColori(nIdColValore) = vbRed
    For k = 1 To nMaxRisultati
        aV(1) = sRuota
        aV(2) = sMese
        For j = 0 To 3
            aV(j + 3) = aValMax(k,j)
        Next
        Call AddRigaTabella(aV,,,,aColori)
    Next
End Sub
Sub GetANumeriPerSvil(aNum)
    Dim k
    ReDim aNum(90)
    For k = 1 To 90
        aNum(k) = k
    Next
End Sub

 

[solare]

Ciao claudio8, grazie e grazie anche a Luigi...
peccato che analizza un anno alla volta