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

  • Discussão Geral

  • 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 oExcel 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, 



    A&A - In Any Place http://inanyplace.blogspot.com/ - bernardess@gmail.com Twitter: @inanyplace

    quinta-feira, 21 de novembro de 2013 16:09