Datos duplicados
Hola a todos. Tengo el siguiente código que busca y marca los datos que estén duplicados en una columna. Quisiera poder modificarlo para que funcione solo con las celdas que selecciono.
Sub Color()
Dim iListCount As Integer
Dim iCtr As Integer
Application.ScreenUpdating = False
iListCount = Range("a65536").End(xlUp).Row 'modificar rango
Range("a1").Select 'celda desde donde empieza a buscar
h = 1
Do Until ActiveCell = ""
For x = 1 To iListCount
For iCtr = h To iListCount
If ActiveCell.Row <> Cells(iCtr, 1).Row Then ' el 1 corresponde al nº de columna
If ActiveCell.Value = Cells(iCtr, 1).Value Then ' el 1 corresponde al nº de columna
Cells(iCtr, 1).Interior.ColorIndex = 6 ' el 1 corresponde al nº de columna
Cells(iCtr, 1).Interior.Pattern = xlSolid ' el 1 corresponde al nº de columna
iCtr = iCtr + 1
End If
End If
Next iCtr
ActiveCell.Offset(1, 0).Select
h = h + 1
Next x
Loop
Application.ScreenUpdating = True
MsgBox "Busqueda finalizada"
End Sub
Desde ya, muy agradecido.
Sub Color()
Dim iListCount As Integer
Dim iCtr As Integer
Application.ScreenUpdating = False
iListCount = Range("a65536").End(xlUp).Row 'modificar rango
Range("a1").Select 'celda desde donde empieza a buscar
h = 1
Do Until ActiveCell = ""
For x = 1 To iListCount
For iCtr = h To iListCount
If ActiveCell.Row <> Cells(iCtr, 1).Row Then ' el 1 corresponde al nº de columna
If ActiveCell.Value = Cells(iCtr, 1).Value Then ' el 1 corresponde al nº de columna
Cells(iCtr, 1).Interior.ColorIndex = 6 ' el 1 corresponde al nº de columna
Cells(iCtr, 1).Interior.Pattern = xlSolid ' el 1 corresponde al nº de columna
iCtr = iCtr + 1
End If
End If
Next iCtr
ActiveCell.Offset(1, 0).Select
h = h + 1
Next x
Loop
Application.ScreenUpdating = True
MsgBox "Busqueda finalizada"
End Sub
Desde ya, muy agradecido.
1 Respuesta
Respuesta de santiagomf
1
Te he reescrito la macro para que trabaje sobre un rango de celdas. Puedes hacer que se ejecute sobre un rango de celdas fijo o bien ejecutarlo sobre las celdas que tengas seleccionadas en el momento de ejecutar la macro.
El código sería el siguiente:
Option Explicit
Sub Color()
Dim strCeldas As String
Dim rangoCeldas As Range
Dim i As Integer
Dim j As Integer
Dim aux As String
Dim listaAnteriores As String
Dim c0 As String
c0 = Chr$(0) ' Usaremos este carácter como separador de valores
' Leemos la dirección del rango de celdas seleccionado
strCeldas = Selection.Address ' El rango de celdas seleccionado
' También podríamos poner que se ejecute sobre un rango de celdas fijo
' poniendo las direcciones de las celdas en la siguiente línea y
' quitando la comilla del comentario
'strCeldas = "A12:J17" ' Un rango de celdas fijo
' Asignamos las celdas a un objeto del tipo rango
Set rangoCeldas = Range(strCeldas)
rangoCeldas.Interior.ColorIndex = xlNone ' Quitamos el fondo de color
' Inicializamos la lista de valores anteriores
listaAnteriores = c0
For i = 1 To rangoCeldas.Rows.Count ' Para cada fila del rango
rangoCeldas.Rows(i).Select
For j = 1 To rangoCeldas.Columns.Count ' Para cada columna
DoEvents ' Para que no se bloquee el ordenador y atienda a otros procesos
' Recuperamos el valor de la celda
aux = rangoCeldas.Cells(i, j).Value2
' Buscaremos el valor entre los anteriores
If InStr(listaAnteriores, c0 & aux & c0) > 0 And aux <> "" Then
' Está repetido.
rangoCeldas.Cells(i, j).Interior.ColorIndex = 6
rangoCeldas.Cells(i, j).Interior.Pattern = xlSolid
Else
' Lo añadimos a la lista
listaAnteriores = listaAnteriores & aux & c0
End If
Next j
Next i
rangoCeldas.Select ' Seleccionamos el rango de celdas que teníamos
MsgBox "Busqueda finalizada"
End Sub
Para saber si un valor esta repetido, lo buscamos en una lista de valores que contiene los ya leídos separados por el carácter 0. Uso ese carácter porque no se puede teclear directamente en una celda Excel y por tanto me sirve para separar los valores que ya haya leído.
De esta forma no es necesario hacer 2 pasadas sobre las celdas a verificar sino que con una pasada y comprobando si lo hemos encontrado ya sería suficiente.
El código sería el siguiente:
Option Explicit
Sub Color()
Dim strCeldas As String
Dim rangoCeldas As Range
Dim i As Integer
Dim j As Integer
Dim aux As String
Dim listaAnteriores As String
Dim c0 As String
c0 = Chr$(0) ' Usaremos este carácter como separador de valores
' Leemos la dirección del rango de celdas seleccionado
strCeldas = Selection.Address ' El rango de celdas seleccionado
' También podríamos poner que se ejecute sobre un rango de celdas fijo
' poniendo las direcciones de las celdas en la siguiente línea y
' quitando la comilla del comentario
'strCeldas = "A12:J17" ' Un rango de celdas fijo
' Asignamos las celdas a un objeto del tipo rango
Set rangoCeldas = Range(strCeldas)
rangoCeldas.Interior.ColorIndex = xlNone ' Quitamos el fondo de color
' Inicializamos la lista de valores anteriores
listaAnteriores = c0
For i = 1 To rangoCeldas.Rows.Count ' Para cada fila del rango
rangoCeldas.Rows(i).Select
For j = 1 To rangoCeldas.Columns.Count ' Para cada columna
DoEvents ' Para que no se bloquee el ordenador y atienda a otros procesos
' Recuperamos el valor de la celda
aux = rangoCeldas.Cells(i, j).Value2
' Buscaremos el valor entre los anteriores
If InStr(listaAnteriores, c0 & aux & c0) > 0 And aux <> "" Then
' Está repetido.
rangoCeldas.Cells(i, j).Interior.ColorIndex = 6
rangoCeldas.Cells(i, j).Interior.Pattern = xlSolid
Else
' Lo añadimos a la lista
listaAnteriores = listaAnteriores & aux & c0
End If
Next j
Next i
rangoCeldas.Select ' Seleccionamos el rango de celdas que teníamos
MsgBox "Busqueda finalizada"
End Sub
Para saber si un valor esta repetido, lo buscamos en una lista de valores que contiene los ya leídos separados por el carácter 0. Uso ese carácter porque no se puede teclear directamente en una celda Excel y por tanto me sirve para separar los valores que ya haya leído.
De esta forma no es necesario hacer 2 pasadas sobre las celdas a verificar sino que con una pasada y comprobando si lo hemos encontrado ya sería suficiente.
