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
A&A® - In Any Place.
