Propósito

✔ Programação GLOBAL® - Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog devem ser tratados como consultoria freelance. Queiram contatar-nos: brazilsalesforceeffectiveness@gmail.com | ESTE BLOG NÃO SE RESPONSABILIZA POR QUAISQUER DANOS PROVENIENTES DO USO DOS CÓDIGOS AQUI POSTADOS EM APLICAÇÕES PESSOAIS OU DE TERCEIROS.

Mostrando postagens com marcador last. Mostrar todas as postagens
Mostrando postagens com marcador last. Mostrar todas as postagens

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, 
Nenhum comentário:
Tags: , , , , , ,

VBA Excel - Retorna a Última Linha de uma planilha

Function LastRow (nColumn As String, InitLine As Single) As Single
    ' Author:                     Date:               Contact:
    ' André Bernardes             11/08/2008 09:01    bernardess@gmail.com
    ' Retorna o número de ocorrências.

    Dim nLine As Single
    Dim nStart As Single
    Dim nFinito As Single
    Dim Cabessalho As Single
    Dim nCeo As String

    Application.Volatile

    Let nStart = InitLine + 1
    Let nFinito = 65000
    Let Cabessalho = InitLine

    Do While nStart < nFinito
        Let nCeo = nColumn & Trim(Str(nStart))

        If Application.ActiveSheet.Range(nCeo).Value = "" Then
            Exit Do
        End If

        'Let Application.StatusBar.Value = " Linha: " & nStart
        Let nStart = nStart + 1
    Loop

    Let LastRow = (nStart - 1) '- Cabeçalho
    'Let Application.StatusBar.Value = "  "
End Function


brazilsalesforceeffectiveness@gmail.com


✔ Brazil SFE®Author´s Profile  Google+   Author´s Professional Profile   Pinterest   Author´s Tweets

Nenhum comentário:
Tags: , , , , , ,

VBA Excel - Retornando o Limite da Coluna de um Range



Como faço para descobrir a última coluna com dados numa Planilha?

Function LASTINCOLUMN (rngInput As Range)
    ' Author:                     Date:               Contact:
    ' André Bernardes             11/08/2008 09:01    bernardess@gmail.com
    '
    Dim WorkRange As Range
    Dim i As Integer, CellCount As Integer
    
    Application.Volatile

    Set WorkRange = rngInput.Columns(1).EntireColumn
    Set WorkRange = Intersect(WorkRange.Parent.UsedRange, WorkRange)
    
    Let CellCount = WorkRange.Count

    For i = CellCount To 1 Step -1
        If Not IsEmpty(WorkRange(i)) Then
            Let LASTINCOLUMN = WorkRange(i).Value
            Exit Function
        End If
    Next i
End Function


Tags: VBA, Excel, UDF, Column, coluna, last, última




Nenhum comentário:
Tags: , , , , , ,

VBA Excel - Juntando distintas planilhas - Combine worksheets in Excel and Kill all excel objects

Inline image 1

Quando estamos trabalhando com várias planilhas, não raramente centenas delas, e precisamos elaborar uma análise, um relatório, importá-las para uma base de dados, etc...Tudo isso seria mais fácil se ao invés de termos centenas de arquivos, tivéssemos acesso a somente uma planilha contendo os dados de todas as demais. Sim, meus caros, nos pouparia muito tempo. E como sempre nos vem a pergunta: Como?

Segue:

Sub CopyFromWorksheets()
Dim wrk As Workbook
Dim sht As Worksheet
Dim trg As Worksheet
Dim rng As Range
Dim colCount As Long
'Dim sheetDelimiter As String
' Creates excel app object
Set objExcel = CreateObject("Excel.Application")
   
' Makes the excel invisible
objExcel.Visible = False
' Supress all display alerts
objExcel.DisplayAlerts = False
' Gets the complete path of the active excel sheet
strExcelFilePath = ActiveWorkbook.FullName
  
' Opens the excel file
Set objWorkbook = objExcel.Workbooks.Open(Trim(strExcelFilePath))

Set objWorkSheet = objWorkbook.Worksheets("Merge")
objWorkSheet.Activate
' Gets the count of column
Set objRange = objWorkbook.Worksheets("Merge")
numRowsCount = objRange.Evaluate("COUNTA(A1:A100)")
Worksheets("Merge").Activate
'sheetDelimiter = "######"
Set wrk = ActiveWorkbook 'Working in active workbook
For Each sht In wrk.Worksheets
If sht.Name = "Consolidated Backlog" Then
MsgBox "There is a worksheet called as 'Consolidated Backlog'." & vbCrLf & _
"Please remove or rename this worksheet since 'Consolidated Backlog' would be" & _
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
Exit Sub
End If
Next sht
Application.ScreenUpdating = False
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
trg.Name = "Consolidated Backlog"
'Get column headers from the first worksheet
'Column count first
Set sht = wrk.Worksheets(1)
colCount = 30

For cntLoop = 1 To numRowsCount
     strSheetName = Trim(UCase(objExcel.Cells(cntLoop, 1).Value))
     If Trim(strSheetName) = "" Then
        Exit For
     End If
     If Trim(strSheetName) = "SHEET NAMES" Then
       GoTo Continue
     End If
     For Each sht In wrk.Worksheets
        'If worksheet in loop is the last one, stop execution (it is Master worksheet)
        If sht.Index = wrk.Worksheets.Count Then Exit For
        If strSheetName = UCase(sht.Name) Then
            'Delimits the copied sheets with a string in a new row
            With trg.Cells(1, 1).Resize(1, colCount)
                .Value = sht.Cells(1, 1).Resize(1, colCount).Value
                 'Set font as bold
                .Font.Bold = True
            End With
            
            trg.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(1, 1).Value = sheetDelimiter
            Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(Rows.Count, 1).End(xlUp).Resize(, colCount))
            rng.Copy trg.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            'Set objRange = sht.Range("A1").EntireColumn
            'objRange.Insert (xlShiftToRight)
            'sht.Range("A1") = sht.Name
        End If
    Next sht
Continue:
Next
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
Set sht = Nothing
Set objWorkSheet = Nothing
Set objRange = Nothing
Set trg = Nothing
Set rng = Nothing
Application.ScreenUpdating = True
'create WMI object instance
Set objWMI = GetObject("winmgmts:")
If Not IsNull(objWMI) Then
'create object collection of Win32 processes
Set objProcList = objWMI.InstancesOf("win32_process")
For Each objProc In objProcList 'iterate through enumerated
If UCase(objProc.Name) = UCase(procName) Then
objProc.Terminate (0)
End If
Next
End If
Set objProcList = Nothing
Set objWMI = Nothing

End Sub

Reference:

Aditya Kalra

Inspiration:
André Luiz Bernardes

Tags: VBA, Tips, dummy, dummies, row, last, cell, célula, dirty area, detect, detectar

Nenhum comentário:
Tags: , , , , , , , , , ,
Assinar: Postagens (Atom)
diHITT - Notícias