MS Excel 2003: cree una columna que debe contener valores únicos

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: cree una columna que debe contener valores únicos

Este tutorial de Excel muestra cómo escribir una macro para crear una columna (con capturas de pantalla e instrucciones paso a paso) que debe contener valores únicos en Excel 2003 y versiones anteriores.

Pregunta: Estoy buscando consejos que me ayuden a crear columnas de datos (alfanuméricos) en Microsoft Excel 2003/XP/2000/97, donde cada fila debe contener datos únicos. Si el usuario ingresa un valor duplicado en una columna, la hoja de cálculo no debería aceptar ese valor.

Respuesta: Hay varios “eventos” disponibles en una hoja de cálculo de Excel donde puede colocar código VBA. En su caso, queremos verificar si hay valores duplicados cuando se activa el evento “Worksheet_Change”.

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 en Sheet1 para que contenga valores únicos. En esta hoja de trabajo, colocamos código en el evento “Worksheet_Change” para que siempre que se ingrese un valor en la columna A (dentro de las primeras 200 filas), la macro probará si el valor se ingresó antes.

Si el valor está duplicado, aparece el siguiente mensaje:

El color de fondo de las celdas que contienen duplicados cambiará a rojo.

En este ejemplo, ingresamos el valor 1234 en la celda A5, que ya existe en la celda A2.

Puede presionar Alt+F11 para ver el código VBA.

codigo macro

El código de la macro se ve así:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

   Dim LLoop As Integer
   Dim LTestLoop As Integer
   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

   'Check first 200 rows in spreadsheet
   While LLoop <= Lrows
      LChangedValue = "A" & CStr(LLoop)

      If Not Intersect(Range(LChangedValue), Target) Is Nothing Then
         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 Range(LChangedValue).Value = Range(LTestValue).Value Then
                     'Set the background color to red
                     Range(LChangedValue).Interior.ColorIndex = 3
                     MsgBox Range(LChangedValue).Value & " already exists in cell A" & LTestLoop
                     Exit Sub
                  Else
                     Range(LChangedValue).Interior.ColorIndex = xlNone
                  End If

               End If

               LTestLoop = LTestLoop + 1
            Wend

         End If   
      End If

      LLoop = LLoop + 1
   Wend

End Sub