✔ VBA Dashboards Specialist®: VBA Excel - Definindo a última linha

13 de novembro de 2013

VBA Excel - Definindo a última linha - How To Delete Rows

Consultancy in Excel, Access, VBA & PowerPoint projects

DESENVOLVO APLICAÇÕES

Perguntas, Questões e Esclarecimentos

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