VBA Excel - Deletando linhas - 09 - Deletando linhas Duplicadas


header2.png

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
 

TagsExcel, Column, Coluna, Delete, Linha, Plan, Planilhas, Report, Row,  rows,worksheet, lines



André Luiz Bernardes
A&A® - In Any Place.

Nenhum comentário:

Postar um comentário

diHITT - Notícias