Condividi:        

Excel: Colora Numeri Ripetuti (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

Excel: Colora Numeri Ripetuti (Lotto)

Postdi Lucio Peruggini » 23/12/12 03:02

Un caloroso ciao a tutti e giacché siamo in tema natalizio e di fine anno, un grandissimo augurio. Speriamo in bene per il prossimo anno!

Avrei una delle mie solite richieste per questa ricerca statistica sul lotto che suppongo abbia bisogno di una macro.

Range D8:H50000
Alla riga 16 e ciclicamente ogni nove, dalla colonna “L alla CW” sono segnati i valori numerici (duplicati) che si trovano in D8:H16. Così per la riga 25 che contiene i duplicati che si trovano in D17:H25 e seguenti.

La macro dovrebbe colorare -unico colore “giallo”- tutte le celle laddove si riscontrano i numeri esistenti nelle righe “L:CW” partendo dalla riga successiva e per nove estrazioni i numeri usciti.

Esempio:
In D8:H16 ci sono sei valori duplicati che si riscontrano per l’appunto alla riga 16 in “L:CW” e sono: 6-26-28-60-61-68.
Orbene, in D17:H25 sono usciti due di questi; il 6 e il 60 ripetuto due volte che ho colorato di giallo.

Nel range successivo e prendendo riferimento dalla riga 25 L:CW abbiamo 12 numeri che sono i duplicati in D17:H25; 1-22-27-43-60-66-70-72-73-77-79-87. Di questi la macro va a colorare quelli usciti in D26:H34 che in questo caso sono:
70-87-43 e 27 uscito tre volte. Così per tutti i cicli successivi composti come detto da nove estrazioni consecutive.

Unico inconveniente: Alla fine di ogni ruota il ciclo s’interrompe e riparte dalla ruota successiva.

Allego tutto il file anche se un pochino grandicello.

https://dl.dropbox.com/u/18220462/FILE/ ... aliano.zip

Ovviamente non c’è nessuna fretta e come sempre ringrazio per l’aiuto.
Buone feste
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Sponsor
 

Re: Excel: Colora Numeri Ripetuti (Lotto)

Postdi Flash30005 » 23/12/12 04:54

Secondo me, come già detto nell'altro quesito, l'archivio posizionato così porterà a probelmi in futuro
perché a seconda della quantità delle estrazioni potresti non avere sempre il multiplo di 9, anzi avrai questa situazione ogni 9 estrazioni aggiunte comunque per colorare di giallo il fondo delle celle se uguali ai numeri riportati nello schema
puoi usare questa macro
Codice: Seleziona tutto
Sub ColoraNumD()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
Range("D8:H" & UR).Interior.ColorIndex = xlNone
For RR = 8 To UR
If Cells(RR, 10).Value <> "" Then
    RR9 = RR
    For CCL = 12 To 101
        If Cells(RR9, CCL).Value <> "" Then
            RU = Cells(RR9, 3).Value
            NumD = Cells(RR9, CCL).Value
            For RRD = RR + 1 To RR + 8
                    For CCD = 4 To 8
                        If Cells(RRD, CCD).Value = NumD Then Cells(RRD, CCD).Interior.ColorIndex = 6
                    Next CCD
            Next RRD
        End If
    Next CCL
End If
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Ciao

N.B. Macro da avviare avendo attivo il foglio interessato


EDIT: Ho modificato il titolo del Topic perché "Macro" non significa nulla e non è utile ad alcuna ricerca
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: Excel: Colora Numeri Ripetuti (Lotto)

Postdi Lucio Peruggini » 23/12/12 11:21

Fleash, grazie!

Ho disposto in questo modo solamente per un controllo visivo e immediato, poi vedrò se vale la pena approfondire ...

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

Re: Excel: Colora Numeri Ripetuti (Lotto)

Postdi Lucio Peruggini » 23/12/12 14:13

Ciao Flash, un’altra cortesia.
https://dl.dropbox.com/u/18220462/IMMAG ... UTI%20.PNG
In K16; K25; k34 e seguenti si dovrebbe marcare il ritardo che ha il primo numero uscito di quelli posti nella stringa L:CW indipendentemente dai nove colpi successivi; anche se i numeri sono più di uno, non ha importanza.

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

Re: Excel: Colora Numeri Ripetuti (Lotto)

Postdi Flash30005 » 23/12/12 15:40

Se ho interpretato bene dovrebbe andare bene questa macro (che sostituisce la precedente)

Codice: Seleziona tutto
Sub ColoraNumD()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
Range("D8:H" & UR).Interior.ColorIndex = xlNone
For RR = 8 To UR
Passo = 0
If Cells(RR, 10).Value <> "" Then
    RR9 = RR
    For CCL = 12 To 101
        If Cells(RR9, CCL).Value <> "" Then
            NumD = Cells(RR9, CCL).Value
            For RRD = RR + 1 To RR + 8
                    For CCD = 4 To 8
                        If Cells(RRD, CCD).Value = NumD Then
                        If Passo = 0 Or RRD - RR < MRD Then Cells(RR, 11).Value = RRD - RR
                        Cells(RRD, CCD).Interior.ColorIndex = 6
                        MRD = RRD - RR
                        Passo = 1
                        End If
                    Next CCD
            Next RRD
        End If
    Next CCL
End If
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


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: Excel: Colora Numeri Ripetuti (Lotto)

Postdi Lucio Peruggini » 23/12/12 23:33

Ciao Flash
Ho provato questa macro e mi sono accorto che in colonna "K" ti fermi nei nove colpi successivi.
Evidentemente non mi sono ben espresso; in colonna K vanno segnati tutti i ritardi anche se questi superano il range di nove colpi.
Interessa, quindi, che in questa colonna si trovi il ritardo minimo di uno dei numeri compresi nella stringa di riferimento.
In pratica, tutte le celle in K devono avere il ritardo anche se questo supera il ciclo nove.

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

Re: Excel: Colora Numeri Ripetuti (Lotto)

Postdi Flash30005 » 23/12/12 23:46

In effetti mi fermavo al modulo 9 successivo
per fare questo aggiungerei una macro simile che scansiona i ritardi mancanti e li trascrive
Inoltre, penso sia utile, evidenziare anche i numeri che hanno sfaldato il ritardo "minimo"
quindi, dopo l'esecuzione, troverai evidenziati in giallo questi numeri (colonne L:CW)
Codice: Seleziona tutto
Sub ColoraNumD()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
Range("D8:CW" & UR).Interior.ColorIndex = xlNone
Columns("K").ClearContents
For RR = 8 To UR
Passo = 0
If Cells(RR, 10).Value <> "" Then
    RR9 = RR
    For CCL = 12 To 101
        If Cells(RR9, CCL).Value <> "" Then
            NumD = Cells(RR9, CCL).Value
            For RRD = RR + 1 To RR + 8
                    For CCD = 4 To 8
                        If Cells(RRD, CCD).Value = NumD Then
                            If Passo = 0 Or RRD - RR < MRD Then Cells(RR, 11).Value = RRD - RR
                            Range(Cells(RR, 12), Cells(RR, 101)).Interior.ColorIndex = xlNone
                            Cells(RR, CCL).Interior.ColorIndex = 6
                            Cells(RRD, CCD).Interior.ColorIndex = 6
                            MRD = RRD - RR
                            Passo = 1
                        End If
                    Next CCD
            Next RRD
        End If
    Next CCL
End If
Next RR
TrovaRit
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub TrovaRit()
UR = Range("A" & Rows.Count).End(xlUp).Row
For RR = 8 To UR
MRD = 1000
Passo = 0
If Cells(RR, 10).Value <> "" And Cells(RR, 11).Value = "" Then
    RR9 = RR
    For CCL = 12 To 101
        If Cells(RR9, CCL).Value <> "" Then
            NumD = Cells(RR9, CCL).Value
            For RRD = RR + 1 To UR
                    For CCD = 4 To 8
                        If Cells(RRD, CCD).Value = NumD Then
                            If Passo = 0 Or RRD - RR < MRD Then Cells(RR, 11).Value = RRD - RR
                            Range(Cells(RR, 12), Cells(RR, 101)).Interior.ColorIndex = xlNone
                            Cells(RR, CCL).Interior.ColorIndex = 6
                            MRD = RRD - RR
                            Passo = 1
                            GoTo SaltaCCL
                        End If
                    Next CCD
            Next RRD
        End If
SaltaCCL:
    Next CCL
End If
Next RR
End Sub


Questa macro sostituisce tutte le precedenti

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: Excel: Colora Numeri Ripetuti (Lotto)

Postdi Lucio Peruggini » 24/12/12 00:36

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

Ciao Flash, ovviamente grazie per il grande aiuto, vi è però un errore.
Riga 1942 colonna ”K” porta il ritardo 38 del numero 62 colorato in giallo nella medesima. Orbene, il primo dei numeri di questa stringa a sfaldarsi è il numero 15 a ritardo 30, riga 1972 colonna “D” e non il 62.
Salvo che io non abbia commesso un errore:
Ho sostituito la macro precedente utilizzando il medesimo pulsante per farla partire.
Devo forse mettere un altro pulsante e far partire prima una macro e poi l’altra? Ho lavorano prima una poi l’altra senza l’aggiunta di altro pulsante dove assegnare la seconda macro?

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

Re: Excel: Colora Numeri Ripetuti (Lotto)

Postdi Flash30005 » 24/12/12 01:40

Ok
Avevo messo una condizione parziale
prova questa
Codice: Seleziona tutto
Sub ColoraNumD()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
Range("D8:CW" & UR).Interior.ColorIndex = xlNone
Columns("K").ClearContents
For RR = 8 To UR
MRD = 1000
If Cells(RR, 10).Value <> "" Then
    RR9 = RR
    For CCL = 12 To 101
        If Cells(RR9, CCL).Value <> "" Then
            NumD = Cells(RR9, CCL).Value
            For RRD = RR + 1 To RR + 8
                    For CCD = 4 To 8
                        If Cells(RRD, CCD).Value = NumD Then
                            Cells(RRD, CCD).Interior.ColorIndex = 6
                            If Cells(RR, 11).Value = "" Or RRD - RR < MRD Then
                            Cells(RR, 11).Value = RRD - RR
                            Range(Cells(RR, 12), Cells(RR, 101)).Interior.ColorIndex = xlNone
                            Cells(RR, CCL).Interior.ColorIndex = 6
                            MRD = RRD - RR
                            End If
                        End If
                    Next CCD
            Next RRD
        End If
    Next CCL
End If
Next RR
TrovaRit
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub TrovaRit()
UR = Range("A" & Rows.Count).End(xlUp).Row
For RR = 8 To UR
MRD = 1000
'Passo = 0
If Cells(RR, 10).Value <> "" And Cells(RR, 11).Value = "" Then
    RR9 = RR
    For CCL = 12 To 101
        If Cells(RR9, CCL).Value <> "" Then
            NumD = Cells(RR9, CCL).Value
            For RRD = RR + 1 To UR
                    For CCD = 4 To 8
                        If Cells(RRD, CCD).Value = NumD Then
                            If Cells(RR, 11).Value = "" Or RRD - RR < MRD Then
                                Cells(RR, 11).Value = RRD - RR
                                Range(Cells(RR, 12), Cells(RR, 101)).Interior.ColorIndex = xlNone
                                Cells(RR, CCL).Interior.ColorIndex = 6
                                MRD = RRD - RR
                            End If
                            GoTo SaltaCCL
                        End If
                    Next CCD
            Next RRD
        End If
SaltaCCL:
    Next CCL
End If
Next RR
End Sub


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: Excel: Colora Numeri Ripetuti (Lotto)

Postdi Flash30005 » 24/12/12 01:52

Due macro per fare la stessa cosa (o quasi) sono inutili
quindi propongo questa unica macro che sostituisce le precedenti
Codice: Seleziona tutto
Sub ColoraNumD()
Application.ScreenUpdating = False
Application.Calculation = xlManual
UR = Range("A" & Rows.Count).End(xlUp).Row
Range("D8:CW" & UR).Interior.ColorIndex = xlNone
Columns("K").ClearContents
For RR = 8 To UR
MRD = 1000
If Cells(RR, 10).Value <> "" Then
    RR9 = RR
    For CCL = 12 To 101
        If Cells(RR9, CCL).Value <> "" Then
            NumD = Cells(RR9, CCL).Value
            For RRD = RR + 1 To UR
                    For CCD = 4 To 8
                        If Cells(RRD, CCD).Value = NumD Then
                            If RRD <= RR + 8 Then Cells(RRD, CCD).Interior.ColorIndex = 6
                            If Cells(RR, 11).Value = "" Or RRD - RR < MRD Then
                            Cells(RR, 11).Value = RRD - RR
                            Range(Cells(RR, 12), Cells(RR, 101)).Interior.ColorIndex = xlNone
                            Cells(RR, CCL).Interior.ColorIndex = 6
                            MRD = RRD - RR
                            End If
                            GoTo SaltaCCL
                        End If
                    Next CCD
            Next RRD
        End If
SaltaCCL:
    Next CCL
End If
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


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: Excel: Colora Numeri Ripetuti (Lotto)

Postdi Lucio Peruggini » 24/12/12 02:15

OK, ora è a posto!!!

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


Torna a Applicazioni Office Windows


Topic correlati a "Excel: Colora Numeri Ripetuti (Lotto)":


Chi c’è in linea

Visitano il forum: Nessuno e 47 ospiti