MS Excel - Deletando linhas - 07 – Linhas duplicadas - Delete duplicate rows

Termo de Responsabilidade

Olá novamente... Vez por outra colamos bases de dados no MS Excel para análise e sem que nos apercebamos dados duplicados acabam ficando juntos em nosso range.

Como efetuar uma depuração que retire as ocorrências duplicadas deixando somente uma versão de cada registro?

Pois bem, a solução abaixo é o resultado de tal necessidade. Implementem, deixem o crédito para quem desenvolveu e tudo estará bem.

Public Sub DelDupliRows (rng As Range)

' Author: Date: Contact:

' André Bernardes 29/01/2009 12:18 bernardess@gmail.com

' Esta SUB deletará registros (linhas) duplicadas, será baseada no Range passado

' como parâmetro. Quando esta SUB achar mais duma ocorrência no mesmo Range,

' todas as ocorrências seguintes serão deletadas.

Dim r As Long

Dim n As Long

Dim v As Variant

On Error GoTo EndMacro

Let Application.ScreenUpdating = False

Let Application.Calculation = xlCalculationManual

Let Application.StatusBar = "Linha sendo processada: " & _ 
Format(rng.Row, "#,##0")

Let n = 0

For r = rng.Rows.Count To 2 Step -1

If r Mod 500 = 0 Then

Let Application.StatusBar = "Processing Row: " & 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 CStr(n) & "Linha(s) Duplicada(s) Deleta(s) "

End Sub

Tags: Excel, Column, Coluna, Delete, Linha, Plan, Planilhas, Report, Row,  rows,worksheet, lines, duplicate, duplicado, dados, paste, cut

André Luiz Bernardes

A&A® - In Any Place.