Eliminar valores repetidos numa lista - JJoão (02/2003)

Rotina que elimina linhas com valores repetidos, este metodo usa a função do Excel Contar.se(Intervalo, valor), o que evita ordenar a lista de modo a colocar os repetidos todos seguidos para comparação.
Deve posicionar-se na coluna que contêm os valores a eliminar.

Sub EliminarValoresDuplicados()
    Dim Linha As Integer, Linhas As Integer
    Dim Celulas As Range, Coluna As Range
    Dim Valor
    On Error GoTo Erro
    With Application
     'Congela o ecran de modo a não se ver a execução da macro
      .ScreenUpdating = False
     'para que não se perca tempo com calculos durante a execução da macro
      .Calculation = xlCalculationManual
    End With
   'Contar as linhas da selecção
    Linhas = Selection.Rows.Count
    If Linhas = 1 Then
      'se não houver celulas selecionadas será
      'levado em conta as linhas da zona preenchida
       Set Celulas = ActiveSheet.UsedRange.Rows
    Else
      'Se houver mais de uma usa a selecção
       Set Celulas = Selection
    End If
   'Define a coluna que irá determinar a
   'localização das linhas a verificar
    Set Coluna = Celulas.Columns(ActiveCell.Column)
   'Começa-se a verificação do fim para o principio
    For Linha = Celulas.Rows.Count To 1 Step -1
       'recolhe-se o valor para se efectuar a contagem
        Valor = Celulas.Cells(Linha, 1).Value
       'Conta-se o numero de vezes que este valor
       'se repete no intervalo de celulas
        If Application.WorksheetFunction.CountIf(Coluna, Valor) > 1 Then
          'se houver repetição a linha será eliminada
           Celulas.Rows(Linha).EntireRow.Delete
        End If
    Next Linha
Erro:
   'repõe-se o estado normal da aplicação
   'em termos de visualização e calculo
    With Application
         .ScreenUpdating = True
         .Calculation = xlCalculationAutomatic
    End With
End Sub