MS Excel 2003: duplicados de contenido de celda parcial en la columna de prueba

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
(Visited 2 times, 1 visits today)