Condividi:        

Macro per il Lotto

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Macro per il Lotto

Postdi Lucio Peruggini » 08/10/12 23:02

Buona serata

Gentilmente, vorrei apportare una modifica a questa macro se non sbaglio fatta da Avatar nel 2011. Essa colora i numeri (range A2:G46471) che sono inseriti da “L1” in poi e inoltre, nella colonna “I” segna il ritardo intercorso fra un numero e l’atro.

La modifica consiste:
In “E1” inserisco un numero a piacimento da 1 a 90 e in “L1; 2; 3; ecc. inserisco i numeri da ricercare.
Orbene, in colonna “I” vorrei ottenere il ritardo dei numeri inseriti in (L1; 2; 3; ecc.); ritardo che è condizionato dall’uscita del numero inserito in in “E1”.
Nel foglio che allego ho portato 5 esempi con il numero 1 segnando il ritardo colorato in arancione nella colonna accanto “H”. Vi è inoltre un fattore da tener presente:
Supponendo che il numero in questione esca più volte prima dell’uscita dei numeri inseriti in (L1; 2; 3; ecc.), il ritardo va contato dall’ultimo numero 1 uscito.
Riporto il primo esempio che si trova in colonna “A7” dove vi è per l’appunto l’1; il quale viene seguito da un altro 1 in “A11”. E’ da qui che parte la conta per il ritardo di uno dei numeri in L1; 2; 3; ecc. che in questo caso è 5 con il numero 60.
P.S.
Dimenticavo che ci sono dieci ruote l’una dopo l’atra e, ad ogni cambio ruoto il conteggio parte da zero.

https://dl.dropbox.com/u/18220462/FILE/ ... rdi%29.zip

https://dl.dropbox.com/u/18220462/FILE/ ... ntaRit.txt


Ciao e grazie per l’aiuto.
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Sponsor
 

Re: Macro per il Lotto

Postdi Anthony47 » 09/10/12 01:50

Scusa, non so se e' l' orticaria per l' argomento o se effettivamente ci sono un paio di errori:
-con "L1; 2; 3; ecc." intendi L1, L2, L3 etc oppure L1, M1, N1 etc??
-per "colonna A7" intendi per caso cella E7?
Poi, perche' non hai segnato il ritardo del 60 presente in G18 (dovrebbe essere 7?) e del 90 presente in D19 (dovrebbe essere 0?). Analoga domanda per il 60 in E32, E44 e altre posizioni.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro per il Lotto

Postdi Flash30005 » 09/10/12 08:35

Questa macro dovrebbe risolvere
Codice: Seleziona tutto
Sub ColoraEContaRitDef()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        UC = Worksheets("Archivio_con_Macro").Range("IV1").End(xlToLeft).Column
        URD = Worksheets("Archivio_con_Macro").Range("C" & Rows.Count).End(xlUp).Row
        Worksheets("Archivio_con_Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
            Worksheets("Archivio_con_Macro").Columns("I:I").ClearContents
        Area = "C2:G" & URD
        Ruota = ""
        ValRes = Worksheets("Archivio_con_Macro").Range("E1").Value
            For Each Valca In Worksheets("Archivio_con_Macro").Range(Area)
               If ValRes = Valca Then
                Valca.Interior.ColorIndex = 44
                End If
            Next
        For RR = 2 To URD
            Ruota = Worksheets("Archivio_con_Macro").Range("B" & RR).Value
            If MRuota <> Ruota Then
                ContaR = 0
                MRuota = Ruota
            Else
                MyC = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!L1:N1))")
                MyRes = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!E1:E1))")
                If MyRes = 1 Then
                    ContaR = 0
                    TrRes = 1
                Else
                    If MyC > 0 And TrRes = 1 Then
                        Worksheets("Archivio_con_Macro").Range("I" & RR).Value = ContaR
                        ContaR = 0
                        TrRes = 0
                        For CC1 = 3 To 7
                        ValT = Worksheets("Archivio_con_Macro").Cells(RR, CC1).Value
                        If ValT = [L1] Or ValT = [M1] Or ValT = [N1] Then Worksheets("Archivio_con_Macro").Cells(RR, CC1).Interior.ColorIndex = 6
                        Next CC1
                    End If
                End If
            End If
            ContaR = ContaR + 1
        Next RR
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub


Rinomina il foglio da
"Archivio con macro"
a
"Archivio_con_macro" (senza spazi)

Ciao

EDIT:
se non vuoi evidenziare i numeri "1" e velocizzare la macro puoi eliminare questi passi
Codice: Seleziona tutto
        Area = "C2:G" & URD

        ValRes = Worksheets("Archivio_con_Macro").Range("E1").Value
            For Each Valca In Worksheets("Archivio_con_Macro").Range(Area)
               If ValRes = Valca Then
                Valca.Interior.ColorIndex = 44
                End If
            Next
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Macro per il Lotto

Postdi Lucio Peruggini » 09/10/12 10:49

Anthony47 ha scritto:Scusa, non so se e' l' orticaria per l' argomento o se effettivamente ci sono un paio di errori:
-con "L1; 2; 3; ecc." intendi L1, L2, L3 etc oppure L1, M1, N1 etc??
-per "colonna A7" intendi per caso cella E7?
Poi, perche' non hai segnato il ritardo del 60 presente in G18 (dovrebbe essere 7?) e del 90 presente in D19 (dovrebbe essere 0?). Analoga domanda per il 60 in E32, E44 e altre posizioni.

Ciao


Ciao Anthony, chiedo scusa per la semplicità con la quale ho esposto il quesito, pensavo che attraverso la macro e il foglio allegato si poteva risalire facilmente a quanto chiesto.

In effetti, si tratta di L1, M1, N1 etc.; per la colonna "A7" avrei dovuto scrivere riga 7 dosi si trova il primo 1.

Per il 60 non è necessario in quanto quello che interessa è il primo numero trovato dopo l'uscita dell'1 che in questo caso si tratta del 60 do C16 (rit. 5).

Flash Ora sto uscendo e quando torno controllo, intanto vi ringrazio.
Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: Macro per il Lotto

Postdi Lucio Peruggini » 09/10/12 11:44

Ciao Flash

La correzione è perfetta ma esaminando tutto il contenuto,farebbe comodo per la ricerca stessa, una ulteriore aggiunta.
Potresti inserire in colonna "J " anche il ritardo che parte dal primo (1) ?
In questo caso sarebbe (9) come da immagine allegata.

https://dl.dropbox.com/u/18220462/IMMAG ... itardi.PNG

GRAZIEEEEEEEEEEEEEEEEEEEEEEEEEEE, siete troppo forti!!!

Un caro saluto
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: Macro per il Lotto

Postdi Lucio Peruggini » 09/10/12 11:57

Solo ora ho notato che vi è una svista. Ad ogni cambio ruota, la macro deve ripartire da zero; vedi foto

https://dl.dropbox.com/u/18220462/IMMAG ... ra%20a.PNG


Qui ho cambiato il numero spia in "E1" che è 90 anziché 1
ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: Macro per il Lotto

Postdi Flash30005 » 09/10/12 12:45

Aggiungi il reset della variabile TrRes dove indicato
Codice: Seleziona tutto
...
            If MRuota <> Ruota Then  '<<< condizione esistente
                ContaR = 0                  '<<< esistente
                TrRes = 0                      '<<<<<<<<<<<<<<< aggiungere
                MRuota = Ruota           '<<< esistente
            Else                                 '<<< esistente
....

Edit
per l'altro quesito ci devo lavorare

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Macro per il Lotto

Postdi Lucio Peruggini » 09/10/12 13:27

Ok, va bene!
Prenditi il tempo dovuto, non c'è fretta.
Ciao
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: Macro per il Lotto

Postdi Flash30005 » 09/10/12 13:38

Prova questo anche se ho dei dubbi sulle specifiche
in pratica questa macro assegnerà il valore ritardo dal primo numero spia (1) fino allo sfaldamento con uscita di uno dei numeri ricercati (30, 60, 90) e solo in questa condizione si azzera il conteggio
Codice: Seleziona tutto
Sub ColoraEContaRitDef()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        UC = Worksheets("Archivio_con_Macro").Range("IV1").End(xlToLeft).Column
        URD = Worksheets("Archivio_con_Macro").Range("C" & Rows.Count).End(xlUp).Row
        Worksheets("Archivio_con_Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
            Worksheets("Archivio_con_Macro").Columns("I:J").ClearContents
        Area = "C2:G" & URD
        Ruota = ""
        ValRes = Worksheets("Archivio_con_Macro").Range("E1").Value
            For Each Valca In Worksheets("Archivio_con_Macro").Range(Area)
               If ValRes = Valca Then
                Valca.Interior.ColorIndex = 44
                End If
            Next
        For RR = 2 To URD
            Ruota = Worksheets("Archivio_con_Macro").Range("B" & RR).Value
            If MRuota <> Ruota Then
                ContaRI = 0
                ContaR = 0
                TrRes = 0
                MRuota = Ruota
            Else
                MyC = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!L1:N1))")
                MyRes = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!E1:E1))")
                If MyRes = 1 Then
                    ContaR = 0
                    TrRes = 1
                Else
                    If MyC > 0 And TrRes = 1 Then
                       Worksheets("Archivio_con_Macro").Range("I" & RR).Value = ContaR
                       If ContaR <> ContaRI Then Worksheets("Archivio_con_Macro").Range("J" & RR).Value = ContaRI
                        ContaR = 0
                        ContaRI = 0
                        TrRes = 0
                        For CC1 = 3 To 7
                            ValT = Worksheets("Archivio_con_Macro").Cells(RR, CC1).Value
                            If ValT = [L1] Or ValT = [M1] Or ValT = [N1] Then Worksheets("Archivio_con_Macro").Cells(RR, CC1).Interior.ColorIndex = 6
                        Next CC1
                    End If
                End If
            End If
            ContaR = ContaR + 1
           If TrRes = 1 Then ContaRI = ContaRI + 1
        Next RR
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub


Prova e fai sapere

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Macro per il Lotto

Postdi Lucio Peruggini » 09/10/12 13:57

https://dl.dropbox.com/u/18220462/IMMAG ... %20I-J.PNG

Ciao
C'è errore se così si può definire.
In colonna "J " deve segnare tutti i ritardi anche se uguali alla colonna " I "
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: Macro per il Lotto

Postdi Flash30005 » 09/10/12 14:13

Pensa tu!
Era così ma mi sembrava superfluo e ho aggiunto una condizione che dovrai togliere:
verso la fine della macro hai questa riga codice
Codice: Seleziona tutto
           If TrRes = 1 Then ContaRI = ContaRI + 1

devi solo eliminare la condizione e lasciare solo questo:
Codice: Seleziona tutto
            ContaRI = ContaRI + 1


ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Macro per il Lotto

Postdi Flash30005 » 09/10/12 14:26

Errata corrige

Non era quella (del post precedente) la condizione da modificare, quindi ripristina quella riga
e modifica questa
Codice: Seleziona tutto
                   
If MyC > 0 And TrRes = 1 Then  '<<<<<<<<<<<<<<< esistente
  Worksheets("Archivio_con_Macro").Range("I" & RR).Value = ContaR '<<<<<<<<<<< esistente
  If ContaR <> ContaRI Then Worksheets("Archivio_con_Macro").Range("J" & RR).Value = ContaRI  '<<< da modificare

così:
Codice: Seleziona tutto
Worksheets("Archivio_con_Macro").Range("J" & RR).Value = ContaRI 


ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Macro per il Lotto

Postdi Lucio Peruggini » 09/10/12 14:45

IMPECCABILE!!!

GRAZIE DI CUORE

Scusatemi se ogni tanto vi rompo, buona giornata.
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: Macro per il Lotto

Postdi Lucio Peruggini » 09/10/12 18:17

Ciao Flash

Lavorando su questa ricerca non ti nascondo che mi farebbe comodo ancora un'aggiunta.
Si tratta di inserire una sorta di "Step" che faccia lavorare la macro a ruota singola oppure tutte insieme com'è ora.

In pratica, inserendo in "F2" la sigla (Ba) la macro lavorerà esclusivamente su di essa; idem per le altre ruote.
Quando voglio esaminarle tutte, inserisco la sigla (TT) oppure niente; come viene più comodo.

N.B. Prometto che per un mese non mi sentite più..................... (scherzo), è solamente per ringraziare perché apprezzo il sostegno e tempo che impiegate gratuitamente al Forum.

Buona serata
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: Macro per il Lotto

Postdi Flash30005 » 09/10/12 22:15

Forse volevi dire in F1 (non F2)
quindi in F1 inserisci la convalida
dal Munu Dati -> Convalida
consenti: Elenco
e in origine inserisci questa stinga
Codice: Seleziona tutto
Ba;Ca;Fi;Ge;Mi;Na;Pa;Ro;To;Ve;TT

Poi sostituisci la macro precedente con questa
Codice: Seleziona tutto
Sub ColoraEContaRitDef()
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        UC = Worksheets("Archivio_con_Macro").Range("IV1").End(xlToLeft).Column
        URD = Worksheets("Archivio_con_Macro").Range("C" & Rows.Count).End(xlUp).Row
        Worksheets("Archivio_con_Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
         Worksheets("Archivio_con_Macro").Range("L1:N1").Interior.ColorIndex = 6
        Worksheets("Archivio_con_Macro").Columns("I:J").ClearContents
        Area = "C1:G" & URD
        Ruota = ""
        RuotaDef = Worksheets("Archivio_con_Macro").Range("F1").Value
        ValRes = Worksheets("Archivio_con_Macro").Range("E1").Value
            For Each Valca In Worksheets("Archivio_con_Macro").Range(Area)
               If ValRes = Valca Then
                Valca.Interior.ColorIndex = 44
                End If
            Next
        For RR = 2 To URD
            Ruota = Worksheets("Archivio_con_Macro").Range("B" & RR).Value
            If RuotaDef <> "TT" Then
               If Ruota <> RuotaDef Then GoTo SaltaRR
            End If
            If MRuota <> Ruota Then
                ContaRI = 0
                ContaR = 0
                TrRes = 0
                MRuota = Ruota
            Else
                MyC = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!L1:N1))")
                MyRes = Evaluate("=SUM(COUNTIF(Archivio_con_Macro!C" & RR & ":G" & RR & ",Archivio_con_Macro!E1:E1))")
                If MyRes = 1 Then
                    ContaR = 0
                    TrRes = 1
                Else
                    If MyC > 0 And TrRes = 1 Then
                       Worksheets("Archivio_con_Macro").Range("I" & RR).Value = ContaR
                       Worksheets("Archivio_con_Macro").Range("J" & RR).Value = ContaRI
                        ContaR = 0
                        ContaRI = 0
                        TrRes = 0
                        For CC1 = 3 To 7
                            ValT = Worksheets("Archivio_con_Macro").Cells(RR, CC1).Value
                            If ValT = [L1] Or ValT = [M1] Or ValT = [N1] Then Worksheets("Archivio_con_Macro").Cells(RR, CC1).Interior.ColorIndex = 6
                        Next CC1
                    End If
                End If
            End If
            ContaR = ContaR + 1
           If TrRes = 1 Then ContaRI = ContaRI + 1
SaltaRR:
        Next RR
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub


Allego il file

Ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Macro per il Lotto

Postdi Lucio Peruggini » 09/10/12 23:54

E' magnifico!!! Grande Flash.

Scusami ma vi è un particolare che ricordo bene: Alla riga 1 da "L" in poi potevo inserire quanti numeri volevo a piacimento e non ho fatto subito caso che la stringa lavora solo con tre numeri L1:N1. A me ne servirebbero cinquanta, non per sondarli tutti insieme ma perché (altro particolare), vorrei inserire una riga superiore dove i numeri da ricercare che, poiché diversi, faccio solo che trascinarli alla riga sottostante "la 2" e viceversa quando devo toglierli per esaminarne altri.

https://dl.dropbox.com/u/18220462/IMMAGINI/Cattura2.PNG

Ho provato a pastrocchiare ma i risultati ovviamente sono stati deludenti.

Notte

Piccola correzione, le righe da aggiungere sono due; l'immagine che segue è corretta

https://dl.dropbox.com/u/18220462/IMMAGINI/Cattura3.PNG
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: Macro per il Lotto

Postdi Flash30005 » 10/10/12 00:59

Ma a cosa si riferiscono le ruote sulla riga 1 da L a AG e oltre?
Non vorrei che poi ti venisse in mente di processare anche queste

Inoltre perché mancano i numeri nelle celle V2:Z2 ?
La macro, come hai ben detto, controlla tutti i numeri che inserirai dalla colonna L (riga1) verso destra ma non devono esserci celle vuote
Aggiungo anche che malgrado tu abbia aumentato due righe la testata vedo tutto molto "risicato" (vedi filtro che copre numeri e titoli etc)
Non è meglio lasciare 10 righe di testata dove, un domani, potrai inserirci altre possibili variazioni o valori da considerare per future analisi?

Ti domando questo perché ogni variazione/modifica/implementazione della macro comporta un maggior perdita di tempo rispetto a quando è tutto pianificato sin dall'inizio

ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Macro per il Lotto

Postdi Flash30005 » 10/10/12 02:59

Beh visto che non mi rispondevi perché starai sognando...

ho fatto a modo mio e chissà se vedendo questo file penserai di stare ancora a sognare... :roll: :lol:

Ciao

EDIT ore 11:15 - Sostituito link per implementazione macro
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Re: Macro per il Lotto

Postdi Lucio Peruggini » 10/10/12 04:14

Ciao Flash, sei semplicemente GENIALE!!!
Non ho risposto perché stavo cercando di dormire ma senza risultati. Alle quattro di stamane e dopo essermi rivoltato nel letto mi sono buttato giù (non dal balcone). Ho trovato questo sogno nel cassetto che supera di gran lunga le mie aspettative; che dirti…………….. se ti accontenti di un semplice grazie che viene dal profondo dell’anima, allora…………GRAZIE INFINITE.
Non intendevo affatto farti implementare anche la riga 1; nella 2, avevo inserito dei numeri casuali i quali appartenevano a cinque per ruota.
Quello che non ricordavo era che i numeri inseriti non dovevano avere celle vuote.
Comunque hai risolto magnificamente il progetto che ripeto è andato ben oltre le mie semplici aspettative.
Ciao e buona giornata
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: Macro per il Lotto

Postdi Flash30005 » 10/10/12 04:31

Beh ho cercato di interpretare l'esigenza e implementato secondo una mia visione di analisi
(a proposito ho fatto delle modifiche importanti alla macro e ho sostituito il link per avere il file aggiornato alla versione 5 -Vedi Edit)

comunque volevo farti notare delle "stranezze"
Ho messo dei numeri a caso sia come spia-ruota che numeri da ricercare
ma se noti nella ruota di Cagliari il 2 come spia e la serie (12,22,32,42 etc)

Escono delle frequenze alte del 22 subito dopo il 2 (anche il 32) e cosa strana sia il totale che la parziale corrispondono significa che si sfaldano entrambi (insomma non si lasciano "attendere")

queste strane coincidenze si verificano anche con gli altri numeri (messi lì a caso) e in altre ruote
Se hai ancora il file originale prova a dare un'occhiata a ciò che ho appena detto


ciao
Flash
Win10 + Office 2010 Ita
"Fotografica" al servizio dell'immagine
Avatar utente
Flash30005
Moderatore
 
Post: 8517
Iscritto il: 27/09/07 11:44
Località: Roma +o-

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "Macro per il Lotto":


Chi c’è in linea

Visitano il forum: systemcrack e 37 ospiti