En esta lección seguiremos con la creación de macros que nos servirán para eliminar elementos repetidos de una lista.

Eliminar elementos repetidos en una lista y realizar un registro: en la primera macro que hemos mostrado en esta página eliminamos todos los elementos que aparecen repetidos dentro de una lista quedando uno solo de todos los elementos repetidos. Según para qué realizásemos este proceso nos podría interesar llevar un control de la cantidad de elementos que estaban repetidos, por esto sería conveniente crear en una hoja nueva, un registro de cual es el elemento repetido y el número de veces que aparecía dentro de la lista.

La macro siguiente necesita que los elementos estén ordenados en una primera hoja y que la segunda hoja esté vacía, ya que será aquí donde se realizará el registro de los elementos repetidos.

   Sub EliminarRepetidosYRegistro()

      contador = 1

      valor = ActiveCell.Value

      ActiveCell.Offset(1, 0).Range("A1").Select

      While ActiveCell.Value <> ""

         If ActiveCell.Value = valor Then

            ActiveSheet.Next.Select

            If ActiveCell.Value <> valor Then

               ActiveCell.Offset(1, 0).Range("a1").Select

               ActiveCell.Value = valor

            End If

            ActiveSheet.Previous.Select

            Selection.Delete Shift:=xlUp

            contador = contador + 1

         Else

            If contador <> 1 Then

               ActiveSheet.Next.Select

               ActiveCell.Offset(0, 1).Range("a1").Select

               ActiveCell.Value = contador

               ActiveCell.Offset(0, -1).Range("a1").Select

               ActiveSheet.Previous.Select

            End If

            contador = 1

            valor = ActiveCell.Value

            ActiveCell.Offset(1, 0).Range("A1").Select

         End If

      Wend

      If contador <> 1 Then

         ActiveSheet.Next.Select

         ActiveCell.Offset(0, 1).Range("a1").Select

         ActiveCell.Value = contador

         ActiveCell.Offset(0, -1).Range("a1").Select

         ActiveSheet.Previous.Select

      End If

   End Sub