Macros para pintar celdas repetidas
Macros para colorear y, o resaltar celdas duplicadas en excel
las columnas son "A" Y "E"
2 Respuestas
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 SubTe 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!
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 SubS 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 SubS 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 SubCada 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
- Abre tu libro de excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
- Del lado derecho copia la macro
Recuerda valorar la respuesta.