Views

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

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, 
Tags: , , , , , ,

Nenhum comentário:

Postar um comentário

Assinar: Postar comentários (Atom)
diHITT - Notícias