Como utilizar exemplos de macros para eliminar itens duplicados numa lista no Excel

Mais Informações

A Microsoft fornece exemplos de programação apenas a título informativo, sem qualquer garantia expressa ou implícita, incluindo, sem limitações, as garantias implícitas de comercialização e/ou adequação a um fim específico. Este artigo pressupõe que o utilizador está familiarizado com a linguagem de programação demonstrada e as ferramentas utilizadas para criar e depurar procedimentos. Os técnicos de suporte da Microsoft podem ajudar a explicar a funcionalidade de um determinado procedimento, mas não modificarão estes exemplos para proporcionarem funcionalidades adicionais nem criarão procedimentos adaptados às suas necessidades específicas.

Exemplo 1: eliminar itens duplicados numa única lista

A seguinte macro de exemplo procura numa única lista no intervalo A1:A100 e elimina todos os itens duplicados na lista. Esta macro requer que não tenha células vazias no intervalo de lista. Se a lista contiver células vazias, ordene os dados por ordem ascendente para que as células vazias se ativem no final da lista. 

    Sub DelDups_OneList()
    Dim iListCount As Integer
    Dim iCtr As Integer
    
    ' Turn off screen updating to speed up macro.
    Application.ScreenUpdating = False
    
    ' Get count of records to search through.
    iListCount = Sheets("Sheet1").Range("A1:A100").Rows.Count
    Sheets("Sheet1").Range("A1").Select
    ' Loop until end of records.
    Do Until ActiveCell = ""
       ' Loop through records.
       For iCtr = 1 To iListCount
          ' Don't compare against yourself.
          ' To specify a different column, change 1 to the column number.
          If ActiveCell.Row <> Sheets("Sheet1").Cells(iCtr, 1).Row Then
             ' Do comparison of next record.
             If ActiveCell.Value = Sheets("Sheet1").Cells(iCtr, 1).Value Then
                ' If match is true then delete row.
                Sheets("Sheet1").Cells(iCtr, 1).Delete xlShiftUp
                   ' Increment counter to account for deleted row.
                   iCtr = iCtr + 1
             End If
          End If
       Next iCtr
       ' Go to next record.
       ActiveCell.Offset(1, 0).Select
    Loop
    Application.ScreenUpdating = True
    MsgBox "Done!"
    End Sub

Exemplo 2: Comparar duas listas e eliminar itens duplicados

A macro de exemplo seguinte compara uma lista (principal) com outra lista e elimina itens duplicados na segunda lista que também estão na lista principal. A primeira lista está na Folha1 no intervalo A1:A10. A segunda lista está na Folha2 no intervalo A1:A100. Para utilizar a macro, selecione uma das folhas e, em seguida, execute a macro. 

    Sub DelDups_TwoLists()
    Dim iListCount As Integer
    Dim iCtr As Integer
    
    ' Turn off screen updating to speed up macro.
    Application.ScreenUpdating = False
    
    ' Get count of records to search through (list that will be deleted).
    iListCount = Sheets("sheet2").Range("A1:A100").Rows.Count
    
    ' Loop through the "master" list.
    For Each x In Sheets("Sheet1").Range("A1:A10")
       ' Loop through all records in the second list.
       For iCtr = 1 To iListCount
          ' Do comparison of next record.
          ' To specify a different column, change 1 to the column number.
          If x.Value = Sheets("Sheet2").Cells(iCtr, 1).Value Then
             ' If match is true then delete row.
             Sheets("Sheet2").Cells(iCtr, 1).Delete xlShiftUp
             ' Increment counter to account for deleted row.
             iCtr = iCtr + 1
          End If
       Next iCtr
    Next
    Application.ScreenUpdating = True
    MsgBox "Done!"
    End Sub