Resaltar filas duplicadas
He encontrado en el foro una macro (el experto no se halla disponible ahora si no hubiera contactado con él) para colorear los valores duplicados de una columna. Me gustaría modificar esa macro para que hiciera exactamente lo mismo pero en vez con duplicados de columna con filas duplicadas, es decir que coloreara las filas duplicadas de la hoja1.
La macro a modificar es ésta:
Sub coloreaDup()
'controla col A
Range("A2").Select
ultima = Range("A65536").End(xlUp).Row
'recorro hasta la fila última
While ActiveCell.Row <= ultima
'guardo fila para volver del bucle
filax = ActiveCell.Row
'controlo si aún no tiene color
If ActiveCell.Interior.ColorIndex = xlNone Then
dato = ActiveCell.Value
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell = dato Then
ActiveCell.Interior.ColorIndex = 4
'opcional: colorear también el dato original
Cells(filax, 1).Interior.ColorIndex = 4
End If
Loop While ActiveCell.Row <= ultima And ActiveCell.Row <> filax
End If
'paso a la fila sgte y repito el bucle
Cells(filax + 1, 1).Select
Wend
End Sub
Mi rango de filas en hoja1 es A1:F871 y las filas van de columna A a F.
Creo que solo hay que modificar estas líneas:
Range("A2").Select
ultima = Range("A65536").End(xlUp).Row
La macro a modificar es ésta:
Sub coloreaDup()
'controla col A
Range("A2").Select
ultima = Range("A65536").End(xlUp).Row
'recorro hasta la fila última
While ActiveCell.Row <= ultima
'guardo fila para volver del bucle
filax = ActiveCell.Row
'controlo si aún no tiene color
If ActiveCell.Interior.ColorIndex = xlNone Then
dato = ActiveCell.Value
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell = dato Then
ActiveCell.Interior.ColorIndex = 4
'opcional: colorear también el dato original
Cells(filax, 1).Interior.ColorIndex = 4
End If
Loop While ActiveCell.Row <= ultima And ActiveCell.Row <> filax
End If
'paso a la fila sgte y repito el bucle
Cells(filax + 1, 1).Select
Wend
End Sub
Mi rango de filas en hoja1 es A1:F871 y las filas van de columna A a F.
Creo que solo hay que modificar estas líneas:
Range("A2").Select
ultima = Range("A65536").End(xlUp).Row
Respuesta de Frank Saaa
1
Quisiera sumar con esta Macro que encontré por ahí. Básicamente recorre fila por fila (puedes poner el rango de la fila) y pintar los valores duplicados de esa fila.
Ojo cambiar "Hoja5" por el nombre de tu hoja.
Sub marcarduplicadosfilas()
Dim i As Double
'Definimos las fila que queremos analizar y marcar elementos duplicados
fin = Application.CountA(Worksheets("Hoja5").Range("A:A"))
For i = 2 To fin
'Definimos el rango de cada fila, desde la celda 1 hasta el final de la hoja
Range(Cells(i, 1), Cells(i, 9)).Select
'Indicamos para cada fila y rango seleccionado el mismo proceso mediante un bucle
'donde debe encontrar las celdas que se repitan en cada fila y marcarlas en azul.
With Selection
'borramos formatos condicionales previos
.FormatConditions.Delete
'utilizamos el método FormatConditions.AddUniqueValues para detectar
'valores unicos o duplicados
.FormatConditions.AddUniqueValues
'seleccionamos y marcamos en azul los valores duplicados
.FormatConditions(1).DupeUnique = xlDuplicate
.FormatConditions(1).Interior.Color = vbblue
End With
Next
End Sub
1 respuesta más de otro experto
Respuesta de prozac
1
Aquí te dejo las funciones para hacer lo que quieres. Incluso el borrado si descomentas la última llamada en la macro (el sub sin parámetros). Espero que te sirva.
Sub EncadenaColumnas(r As Range)
'encadena los vlores de cada fila en la siguiente columna
Dim i As Integer
Dim j As Integer
Dim maxi As Integer 'maximo numero de filas
Dim maxj As Integer ' maximo numero de columnas
Dim s As String
maxi = r.Rows.Count
maxj = r.Columns.Count
For i = 1 To maxi
s = ""
For j = 1 To maxj
s = s & Cells(i, j).Value
Next j
Cells(i, maxj + 1).Value = s 'copio el valor en la columna siguiente
Next i
End Sub
Sub ColoreaDuplicadosColumna(c As Range, micolor As Integer)
'c debe ser una columna
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim maxi As Integer 'maximo numero de filas
j = c.Column
maxi = c.Rows.Count
For i = 1 To maxi
For x = i + 1 To maxi
If Cells(i, j).Value = Cells(x, j).Value Then
'coloreo la primera
Cells(i, j).Interior.ColorIndex = micolor
End If
Next x
Next i
End Sub
Sub BorraFilasColoreadas(c As Range, micolor As Integer)
Dim i As Integer
Dim j As Integer
Dim maxi As Integer 'maximo numero de filas
j = c.Column
maxi = c.Rows.Count
For i = maxi To 1 Step -1 'en orden inverso
If Cells(i, j).Interior.ColorIndex = micolor Then
Rows(i).Select
Selection.Interior.ColorIndex = micolor
'Selection.Delete Shift:=xlUp 'descomentar para borrar
End If
Next i
End Sub
Sub ColoreaBorraFilasDuplicadas()
Dim r As Range
Dim c As Range
Set r = Range("A1:F871")
Set c = Range("G1:G871")
Call EncadenaColumnas(r)
Call ColoreaDuplicadosColumna(c, 3)
'Call BorraFilasColoreadas(c, 3) 'descomentar pra que se ejecute
End Sub
El modo para saber filas duplicadas es encadenar los valores de las celdas de la fila en una sola columna adicional (la g en el ejemplo) y mirar ahí los duplicados. En el ejemplo las filas cuya columna está coloreada se colorean enteras. Si quieres borrarlas enteras es descomentar la linea siguiente donde se borran y comentar la que colorea dentro de la función BorraFilasColoreadas.
Así tienes un método alternativo para borrar o colorear.
Sub EncadenaColumnas(r As Range)
'encadena los vlores de cada fila en la siguiente columna
Dim i As Integer
Dim j As Integer
Dim maxi As Integer 'maximo numero de filas
Dim maxj As Integer ' maximo numero de columnas
Dim s As String
maxi = r.Rows.Count
maxj = r.Columns.Count
For i = 1 To maxi
s = ""
For j = 1 To maxj
s = s & Cells(i, j).Value
Next j
Cells(i, maxj + 1).Value = s 'copio el valor en la columna siguiente
Next i
End Sub
Sub ColoreaDuplicadosColumna(c As Range, micolor As Integer)
'c debe ser una columna
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim maxi As Integer 'maximo numero de filas
j = c.Column
maxi = c.Rows.Count
For i = 1 To maxi
For x = i + 1 To maxi
If Cells(i, j).Value = Cells(x, j).Value Then
'coloreo la primera
Cells(i, j).Interior.ColorIndex = micolor
End If
Next x
Next i
End Sub
Sub BorraFilasColoreadas(c As Range, micolor As Integer)
Dim i As Integer
Dim j As Integer
Dim maxi As Integer 'maximo numero de filas
j = c.Column
maxi = c.Rows.Count
For i = maxi To 1 Step -1 'en orden inverso
If Cells(i, j).Interior.ColorIndex = micolor Then
Rows(i).Select
Selection.Interior.ColorIndex = micolor
'Selection.Delete Shift:=xlUp 'descomentar para borrar
End If
Next i
End Sub
Sub ColoreaBorraFilasDuplicadas()
Dim r As Range
Dim c As Range
Set r = Range("A1:F871")
Set c = Range("G1:G871")
Call EncadenaColumnas(r)
Call ColoreaDuplicadosColumna(c, 3)
'Call BorraFilasColoreadas(c, 3) 'descomentar pra que se ejecute
End Sub
El modo para saber filas duplicadas es encadenar los valores de las celdas de la fila en una sola columna adicional (la g en el ejemplo) y mirar ahí los duplicados. En el ejemplo las filas cuya columna está coloreada se colorean enteras. Si quieres borrarlas enteras es descomentar la linea siguiente donde se borran y comentar la que colorea dentro de la función BorraFilasColoreadas.
Así tienes un método alternativo para borrar o colorear.