Macros para pintar celdas repetidas

Macros para colorear y, o resaltar celdas duplicadas en excel

las columnas son "A" Y "E" 

Respuesta
1

Aclara un poco más qué se tiene que comparar: la col A con respecto a la E ... o un registro se considera repetido cuando coinciden las 2 col en diferentes filas... o tal vez haya alguna otra variante.

Sdos!

No, comparar no, en la columna A no se debe repetir ningún dato.

En la columna E tampoco serian columnas separadas

Esta sería una macro para col A... solo debes repetirla para la otra col.

Estoy considerando que los datos empiezan en fila 2 y el color asignado es rojo.

Sub repetidos()
'x Elsamatilde
'para col A empezando en fila 2
rgo = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Address
For Each cd In Range(rgo)
cd.Select
If Application.WorksheetFunction.CountIf(Range(rgo), ActiveCell.Value) > 1 Then
    ActiveCell.Interior.ColorIndex = 3
End If
Next cd
End Sub

Puede funcionar de manera automática¿

Si, en ese caso coloca esta otra macro en el objeto HOJA donde vayas a trabajar.

Private Sub Worksheet_Change(ByVal Target As Range)
'x Elsamatilde
'si se borra el contenido se quita el color
If Target.Value = "" Then Target.Interior.ColorIndex = xlNone
If Not Intersect(Target, Range("A:A")) Is Nothing Then
    If Application.WorksheetFunction.CountIf(Range("A:A"), Target) > 1 Then
        Target.Interior.ColorIndex = 3
    End If
ElseIf Not Intersect(Target, Range("E:E")) Is Nothing Then
    If Application.WorksheetFunction.CountIf(Range("E:E"), Target) > 1 Then
        Target.Interior.ColorIndex = 7
    End If
End If
End Sub

Te quedarán los colores de mi imagen. Para formatear con otros estilos, encendé la grabadora de macros y dale color de fondo y letra a gusto a  cualquier celda (que no se repita). Al detener la grabación encontrarás los nros de color para colocar a esta macro.

Sdos.

Elsa

Te recuerdo que la consulta sigue abierta... no olvides valorarla.

Sdos!

Si tengo en una hoja esta macros y en otra una con buscarv de ingreso de datos al insertarlos me genera error en la macros

Te envié una macro para colorear repetidos... luego solicitaste que sea automática y también te la envié.

¿Ahora me comentas que tenés 2 hojas con procesos distintos y 'genera error en la macros'... de qué macro estamos entonces hablando? ¿Cuál es la que genera error? Y marcame por favor la línea o el mensaje de error.

Sino enviame el libro con las macros y las aclaraciones.

Sdos!

1 respuesta más de otro experto

Respuesta
1

Te anexo la macro, busca los datos en A en E si lo encuentra, entonces pinta de amarillo la celda de la columna A y también de la E

Sub CeldasRepetidas()
'Por.Dante Amor
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Set b = Columns("E").Find(Cells(i, "A"), lookat:=xlWhole)
        If Not b Is Nothing Then
            Cells(i, "A").Interior.ColorIndex = 6
            Cells(b.Row, "E").Interior.ColorIndex = 6
        End If
    Next
End Sub

S a l u d o s . D a n t e   A m o r

Recuerda valorar la respuesta. Gracias

Si le falta algo a la macro, procura poner ejemplos con imágenes de lo que tienes y de lo que esperas como resultado.

Este es el ejemplo las dos columnas son por separado, en la A hay datos repetidos los resalte con el formato condicional al igual que en la E . 

Te anexo la macro para las columnas A y E, si quieres que se comparen más columnas, agrega en esta línea de la macro la letra o las letras de las columnas:

cols = Array("A", "E")

Por ejemplo, si quieres que se compare la columna "F", entonces la línea quedaría así:

cols = Array("A", "E", "F")



Sub PintarRepetidos()
'Por.Dante Amor
    cols = Array("A", "E")
    '
    For c = LBound(cols) To UBound(cols)
        x = Range(cols(c) & Rows.Count).End(xlUp).Row
        For i = 1 To Range(cols(c) & Rows.Count).End(xlUp).Row
            If Cells(i, cols(c)) <> "" Then
                Set r = Columns(cols(c))
                Set b = r.Find(Cells(i, cols(c)), lookat:=xlWhole)
                If Not b Is Nothing Then
                    ncell = b.Address
                    n = 1
                    Do
                        If n > 1 Then
                            b.Interior.ColorIndex = 6
                            Cells(i, cols(c)).Interior.ColorIndex = 6
                        End If
                        Set b = r.FindNext(b)
                        n = n + 1
                    Loop While Not b Is Nothing And b.Address <> ncell
                End If
            End If
        Next
    Next
End Sub

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta.

¿Cómo se pone de manera automática?

Tienes que poner la siguiente macro en los eventos de tu hoja:

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
    If Not Intersect(Target, Range("A:A, E:E")) Is Nothing Then
        cols = Array("A", "E")
        '
        Range("A:A, E:E").Interior.ColorIndex = xlNone
        For c = LBound(cols) To UBound(cols)
            x = Range(cols(c) & Rows.Count).End(xlUp).Row
            For i = 1 To Range(cols(c) & Rows.Count).End(xlUp).Row
                If Cells(i, cols(c)) <> "" Then
                    Set r = Columns(cols(c))
                    Set b = r.Find(Cells(i, cols(c)), lookat:=xlWhole)
                    If Not b Is Nothing Then
                        ncell = b.Address
                        n = 1
                        Do
                            If n > 1 Then
                                b.Interior.ColorIndex = 6
                                Cells(i, cols(c)).Interior.ColorIndex = 6
                            End If
                            Set b = r.FindNext(b)
                            n = n + 1
                        Loop While Not b Is Nothing And b.Address <> ncell
                    End If
                End If
            Next
        Next
    End If
End Sub

Cada que modifiques, borres o agregues un dato en la columna A o E


Sigue las Instrucciones para poner la macro en los eventos de worksheet

  1. Abre tu libro de excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
  4. Del lado derecho copia la macro

Recuerda valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas