Los datos expuestos en este blog, son solo de índole informativo. Por favor realiza siempre una copia de seguridad antes de realizar cualquier cambio en tu proyecto.
MS Excel 2003: duplicados de contenido de celda parcial en la columna de prueba
Este tutorial de Excel explica cómo escribir una macro (con capturas de pantalla e instrucciones paso a paso) para probar duplicados del contenido de algunas celdas en una columna en Excel 2003 y versiones anteriores.
Pregunta: En Microsoft Excel 2003/XP/2000/97, ¿es posible escribir una macro para resaltar cualquier valor duplicado comparando parte del contenido de la celda en la columna A? Mi problema es que a veces los valores de las celdas no coinciden exactamente.
Por ejemplo, la celda A1 contiene “1234” y la celda A2 contiene “1234, 5678”. ¿Hay alguna manera de comparar parte del contenido de la celda para que, en este ejemplo, los indicadores de entrada duplicada se establezcan para las celdas A1 y A2?
R: Veamos un ejemplo.
Descargue la hoja de cálculo de Excel (que se muestra a continuación)
En nuestra hoja de cálculo, configuramos la columna A para que contenga valores únicos. En esta hoja, hemos creado un botón que, al hacer clic, iniciará una macro. Esta macro resaltará todos los valores duplicados en la columna A.
En nuestro ejemplo, hicimos clic en el botón. El color de fondo de la copia parcial ahora será rojo de la siguiente manera:
En este ejemplo, se ingresó un valor parcial de 1234 en las celdas A2, A5 y A6.
Puede presionar Alt+F11 para ver el código VBA.
Tenga en cuenta que la variable LRows en esta macro se establece en 200, lo que significa que la macro probará las primeras 200 filas en la columna A en busca de duplicados. Es posible que deba cambiar este valor para adaptarlo a su volumen de datos.
codigo macro
El código de la macro se ve así:
Sub TestForDups()
Dim LLoop As Integer
Dim LTestLoop As Integer
Dim LClearRange As String
Dim Lrows As Integer
Dim LRange As String
Dim LChangedValue As String
Dim LTestValue As String
'Test first 200 rows in spreadsheet for uniqueness
Lrows = 200
LLoop = 2
'Clear all flags
LClearRange = "A2:A" & Lrows
Range(LClearRange).Interior.ColorIndex = xlNone
'Check first 200 rows in spreadsheet
While LLoop <= Lrows
LChangedValue = "A" & CStr(LLoop)
If Len(Range(LChangedValue).Value) > 0 Then
'Test each value for uniqueness
LTestLoop = 2
While LTestLoop <= Lrows
If LLoop <> LTestLoop Then
LTestValue = "A" & CStr(LTestLoop)
'Value has been duplicated in another cell
If InStr(Range(LTestValue).Value, Range(LChangedValue).Value) > 0 Then
'Set the background color to red
Range(LChangedValue).Interior.ColorIndex = 3
Range(LTestValue).Interior.ColorIndex = 3
End If
End If
LTestLoop = LTestLoop + 1
Wend
End If
LLoop = LLoop + 1
Wend
End Sub