VBA Excel - Deletando linhas Duplicadas

Visite também: | Blog Office VBA | Blog Excel | Blog Access    |

Esta função eliminará todas as linhas duplicadas em um intervalo.

Para usá-la, selecione um intervalo de uma única coluna de células, compreendendo o intervalo de linhas a partir da qual são duplicados a ser excluído, por exemplo, C2:C99. Os valores da coluna selecionada serão comparados para determinar se uma linha tem duplicatas.

Linhas inteiras não são comparadas umas contra as outras. Apenas a coluna selecionada é utilizada para comparação.

Quando forem encontrados valores duplicados na coluna, a primeira linha continua, e todas as linhas subseqüentes são excluídas.

Public Sub DeleteDuplicateRows()
Dim R As Long
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo EndMacro
Let Application.ScreenUpdating = False
Let Application.Calculation = xlCalculationManual

Set Rng = Application.Intersect(ActiveSheet.UsedRange, _
                    ActiveSheet.Columns(ActiveCell.Column))

Let Application.StatusBar = "Processando as linhas: " & Format(Rng.Row, "#,##0")

Let N = 0

For R = Rng.Rows.Count To 2 Step -1
If R Mod 500 = 0 Then
    Application.StatusBar = "Processando as linhas: " & Format(R, "#,##0")
End If

Let V = Rng.Cells(R, 1).Value

If V = vbNullString Then
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), vbNullString) > 1 Then
        Rng.Rows(R).EntireRow.Delete

        Let N = N + 1
    End If
Else
    If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
        Rng.Rows(R).EntireRow.Delete

        Let N = N + 1
    End If
End If
Next R

EndMacro:

Let Application.StatusBar = False
Let Application.ScreenUpdating = True
Let Application.Calculation = xlCalculationAutomatic

MsgBox "Linhas Duplicadas foram Deletadas: " & CStr(N)

End Sub

Source

Caso queira implementar soluções às suas planilhas ou aplicações MS Access, contacte-me: bernardess@gmail.com