Saltar al contenido

Resaltar duplicados con colores iguales


Recommended Posts

Hola, he visto por todo el foro pero nada se compara con lo que necesito.

Necesito que con una macro me resalte los textos duplicados de una columna X, ejemplo

si tengo en A1:A10 estos valores

Casa

Carro

Casa

Carro

Monitor

Tasa

Plato

Celda sin valor o sea en blanco

Carro

Tasa

tengo la siguiente macro, que me funciona si tengo solo 2 valores repetidos pero no me funciona para mas, como podria modificarla. y a la ves que no tomara en cuenta los colores Blanco y Negro.

Bueno adjunto ejemplo, para mejor entendimiento y ver funcionamiento de macro.

Salu2.xlsx

Ejemplo Duplicados.xls

Enlace a comentario
Compartir con otras webs

Saludos.

Prueba con la siguiente macro el unico requisito ya que se utiliza autofiltro es tener un encabezado, espero te sea de utilidad.

Sub filtrar_y_colorear_repetidos()
Dim color As Byte, i, ii, contador, colores As Integer
Dim unicos, unico
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Hoja2")
.Range("E6").Select
For i = 6 To 15
unicos = unicos & "," & .Cells(i, 5)
Next i
unico = Split(unicos, ",")
For ii = 0 To UBound(unico)
color = Int(Rnd * 55) + ii
If color = 28 Then color = color + 5
.Range("E5:E15").AutoFilter Field:=1, Criteria1:=unico(ii)
contador = Application.Subtotal(3, .Range("E6:E15"))
If InStr(colores, color) = 0 Then
If contador > 1 Then
.Range("E6:E15").SpecialCells(xlCellTypeVisible) _
.Interior.ColorIndex = color
End If
End If
Next ii
.Range("E5:E15").AutoFilter
End With
Application.ScreenUpdating = True
End Sub[/CODE]

Atte.

joshua

Enlace a comentario
Compartir con otras webs

Invitado Gengis Khan

Hola Sres.:

Otra forma de hacer lo mismo.

Válido para cualquier número de filas.

No es necesaria la fila de encabezamiento.

No recomendable para mas de 1.000 filas.

Sub Colorear()
Application.ScreenUpdating = False
Fila = 6: Columna = "E" [COLOR=#008000][B]'Sustituir a conveniencia[/B][/COLOR]
For x1 = Fila To Range(Columna & Rows.Count).End(xlUp).Row - 1
For x2 = x1 + 1 To Range(Columna & Rows.Count).End(xlUp).Row
If Range(Columna & x2) = Range(Columna & x1) Then
If Not (Range(Columna & x1).Interior.ColorIndex = xlNone Or _
Range(Columna & x1).Interior.Color = vbWhite Or _
Range(Columna & x1).Interior.Color = vbBlack) Then
Range(Columna & x2).Interior.Color = Range(Columna & x1).Interior.Color
End If
End If
Next
Next
End Sub
Application.ScreenUpdating = True
[/CODE]

Saludos

Enlace a comentario
Compartir con otras webs

Hola, de nuevo he probado ambas macros y una me funciona y otra no, a primera vista me pareció para simple la de Gengis Khan pero no me funciona no pone color a ninguna celda, según el archivo que adjunte, luego probé la macro de joshua y si funciona usando los filtros, me parece que por el momento voy a usar la de joshua si alguien sabe por que no funciona la macro de Khan favor corregirla, gracias a ambos por sus aporte, espero sus comentarios, salu2.xlsx. :glee:

Enlace a comentario
Compartir con otras webs

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.