VBA Excel - Deletando linhas - 09 - Deletando linhas Duplicadas

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     

Let 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
 

Tags: Excel, Column, Coluna, Delete, Linha, Plan, Planilhas, Report, Row,  rows,worksheet, lines

André Luiz Bernardes

A&A® - In Any Place.