Recebi um monte de perguntas sobre qual o melhor modo de excluirmos linhas no MS Excel, dadas várias condições.
Montei alguns exemplos que devem ajudá-los a começar caso precisem enfrentar tal tarefa.
Este post é uma coletânea de exemplos de código VBA - não um tutorial.
Determinando a última linha usada
Use este código ao longo da linha para determinar a última linha com dados num intervalo especificado:
Public Function GetLastRow (ByVal rngToCheck As Range) As Long
Dim rngLast As Range
Set rngLast = rngToCheck.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngLast Is Nothing Then
Let GetLastRow = rngToCheck.Row
Else
Let GetLastRow = rngLast.Row
End If
End Function
Exclua a linha se determinada célula, na coluna, estiver vazia
Este código é apenas uma 'carcaça' modelo que demonstra a maneira mais rápida e simples de excluirmos cada linha da Aba (Sheet1), se as células na coluna A estiverem vazias:
Sub Example1()
Dim lngLastRow As Long
Dim rngToCheck As Range
Let Application.ScreenUpdating = False
With Sheet1
'if the sheet is empty then exit...
If Application.WorksheetFunction.CountA(.Cells) > 0 Then
'find the last row in the worksheet
Let lngLastRow = GetLastRow(.Cells)
Set rngToCheck = .Range(.Cells(1, 1), .Cells(lngLastRow, 1))
If rngToCheck.Count > 1 Then
'if there are no blank cells then there will be an error
On Error Resume Next
rngToCheck.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Else
If VBA.IsEmpty(rngToCheck) Then rngToCheck.EntireRow.Delete
End If
End If
End With
Let Application.ScreenUpdating = True
End Sub
Excluir linhas, se as células na mesma linha estiverem vazias
Este exemplo sobrepõe o anterior, mas apresenta outra nuance quando se trabalha com o método de intervalo do objeto SpecialCells. Este exemplo excluirá todas as linhas na planilha,quando qualquer uma das suas células nas colunas de B a E estiverem vazias.
Sub Example1()
Dim lngLastRow As Long
Dim rngToCheck As Range, rngToDelete As Range
Let Application.ScreenUpdating = False
With Sheet1
'find the last row on the sheet
Let lngLastRow = GetLastRow(.Cells)
If lngLastRow > 1 Then
'we want to check the used range in columns B to E
'except for our header row which is row 1
Set rngToCheck = .Range(.Cells(2, "b"), .Cells(lngLastRow, "e"))
'if there are no blank cells then there will be an error
On Error Resume Next
Set rngToDelete = rngToCheck.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
'allow for overlapping ranges
If Not rngToDelete Is Nothing Then _
Application.Intersect(.Range("A:A"), rngToDelete.EntireRow).EntireRow.Delete
End If
End With
Let Application.ScreenUpdating = True
End Sub
Use o objeto Range para encontrar Método
A abordagem mais tradicional para resolver esta tarefa é percorrer toda a coluna, verificar se cada célula contém o valor e, se isso acontecer, excluir a linha. Como o Excel desloca as linhas para cima quando forem excluídas, é melhor começarmos na parte inferior da coluna.
Sub Example1()
Const strTOFIND As String = "Hello"
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String
Let Application.ScreenUpdating = False
With Sheet1.Range("A:A")
Set rngFound = .Find( _
What:=strTOFIND, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rngFound Is Nothing Then
Set rngToDelete = rngFound
'note the address of the first found cell so we know where we started.
strFirstAddress = rngFound.Address
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
Set rngToDelete = Application.Union(rngToDelete, rngFound)
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Let Application.ScreenUpdating = True
End Sub
Usando o método Range com o Autofiltro
Claro, este procedimento pressupõe que a Linha 1 contém cabeçalhos de campo.
Sub Example2()
Const strTOFIND As String = "Hello"
Dim lngLastRow As Long
Dim rngToCheck As Range
Let Application.ScreenUpdating = False
With Sheet1
'find the last row in the Sheet
Let lngLastRow = GetLastRow(.Cells)
Set rngToCheck = .Range(.Cells(1, 1), .Cells(lngLastRow, 1))
End With
With rngToCheck
.AutoFilter Field:=1, Criteria1:=strTOFIND
'assume the first row had headers
On Error Resume Next
.Offset(1, 0).Resize(.Rows.Count - 1, 1). _
SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0
'remove the autofilter
.AutoFilter
End With
Let Application.ScreenUpdating = True
End Sub
Usando o objeto Range com o método ColumnDifferences
o código abaixo é muito semelhante ao anterior, exceto pela aplicação de uma lógica inversa. Apesar de invertemos a lógica do Range.Autofilter a abordagem será bem simples, está ligeiramente diferente com o método Range.Find.
Sub Example1()
Const strTOFIND As String = "Hello"
Dim lngLastRow As Long
Dim rngToCheck As Range
Dim rngFound As Range, rngToDelete As Range
Let Application.ScreenUpdating = False
With Sheet1
Let lngLastRow = GetLastRow(.Cells)
If lngLastRow > 1 Then
'we don't want to delete our header row
With .Range("A2:A" & lngLastRow)
Set rngFound = .Find( _
What:=strTOFIND, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If rngFound Is Nothing Then
'there are no cells we want to keep!
.EntireRow.Delete
Else
'determine all the cells in the range which have a different value
On Error Resume Next
Set rngToDelete = .ColumnDifferences(Comparison:=rngFound)
On Error GoTo 0
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
End If
End With
End If
End With
Let Application.ScreenUpdating = True
End Sub
Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...
Tags: VBA, Excel, last, row, última, linha, getlastrow,
