Excel Tips - Excluindo linhas em branco ao abrir a Planilha - Removing Blank Rows Automatically

Consultancy in Excel, Access, VBA & PowerPoint projects

DESENVOLVO APLICAÇÕES

Perguntas, Questões e Esclarecimentos

O que é o fenômeno chamado BIG DATA?

Acesse uma ENORME lista de Dashboards e Infográficos

Aprenda a detectar gráficos que precisam mudar

Dados ou Informações?

Dashboards - 8 Importantes características desejáveis

Dashboards e Infocharts - Diversas Visualizações de Dados

Diversos exemplos de Gráficos

Excel - DashMap - Mapa do Brasil

Key Performance Indicators - 7 Características desejáveis

MIS - Usufruindo a excelência na análise das suas Informações

O Melhor do Business Intelligence

Os 10 mandamentos do gerenciamento de projetos

Receba 3 Calendários Customizáveis de  2013 em Excel

Usando Gauges em Dashboards no MS Access

Olá pessoal!

Alguns perguntaram como fazer para deletar as linhas que estão em branco na planilha, logo que a esta for aberta.

Segue um código, simples, honesto, rápido e limpinho.

Private Sub Worksheet_Change (ByVal Target As Range)
'Deleta todas as linhas que estiverem em branco que existirem.  
'Previne loops infinitos  Let Application.EnableEvents = False   
'Caso haja mais de uma célula selecionada. 
If Target.Cells.Count > 1 Then
GoTo SelectionCode  
If WorksheetFunction.CountA(Target.EntireRow) = 0 Then 
Target.EntireRow.Delete 
End If  
Let Application.EnableEvents = True  
Exit Sub
SelectionCode: 
If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then 
Selection.EntireRow.Delete 
End If  
Let Application.EnableEvents = True
End Sub

Tags: VBA, Excel, deletar, apagar, excluir, row, lines, linha, range, rows, blank, removing, EntireRow, automatically, delete

VBA Excel - Excluir linhas em branco logo ao abrir a Planilha - Removing Blank Rows Automatically

| Blog Office VBA | Blog Excel | Blog Access |

+ de 100.000 VISITAS

Acesse: http://goo.gl/0v6AO   

Sim pessoal. sempre perguntam como deletar linhas em branco da planilha, assim que esta for aberta. Segue um código, simples, honesto, rápido e limpinho:

Private Sub Worksheet_Change (ByVal Target As Range)

'Deleta todas as linhas que estiverem em branco que existirem.  

'Previne loops infinitos  Let Application.EnableEvents = False   

'Caso haja mais de uma célula selecionada. 

If Target.Cells.Count > 1 Then

GoTo SelectionCode  

If WorksheetFunction.CountA(Target.EntireRow) = 0 Then 

Target.EntireRow.Delete 

End If  

Let Application.EnableEvents = True  

Exit Sub  

SelectionCode: 

If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then 

Selection.EntireRow.Delete 

End If  

Let Application.EnableEvents = True

End Sub

Tags: VBA, Excel, deletar, apagar, excluir, rows, blank, lines, linha, range, removing, EntireRow, automatically, delete

VBA Excel - Deletando Linhas, Linhas em branco e Linhas duplicadas - Delete Rows, Blank Rows, Delete Row on Cell and Delete Duplicate Rows

| Blog Office VBA | Blog Excel | Blog Access | 

Excluir as linhas em branco ou todas as que estiverem duplicadas numa base de dados pode ser facilitado, seguem três códigos: 

DeleteBlankRows

DeleteRowOnCell

DeleteDuplicateRows

O código DeleteBlankRows descrito a seguir irá apagar todas as linhas em branco na planilha especificada pelo parâmetro WorksheetName. Se este for omitido, a planilha ativa será utilizada. O procedimento apagará as linhas que estiverem totalmente em branco ou contiverem células cujo o conteúdo seja apenas um único apóstrofe (caracter que controla a formatação). O procedimento exige a função IsRowClear, mostrada após o procedimento DeleteBlankRows. 

CÓDIGO:

Sub DeleteBlankRows(Optional WorksheetName As Variant)
' This function will delete all blank rows on the worksheet
' named by WorksheetName. This will delete rows that are
' completely blank (every cell = vbNullString) or that have
' cells that contain only an apostrophe (special Text control
' character).
' The code will look at each cell that contains a formula,
' then look at the precedents of that formula, and will not
' delete rows that are a precedent to a formula. This will
' prevent deleting precedents of a formula where those
' precedents are in lower numbered rows than the formula
' (e.g., formula in A10 references A1:A5). If a formula
' references cell that are below (higher row number) the
' last used row (e.g, formula in A10 reference A20:A30 and
' last used row is A15), the refences in the formula will
' be changed due to the deletion of rows above the formula.
'

Dim RefColl As Collection
Dim RowNum As Long
Dim Prec As Range
Dim Rng As Range
Dim DeleteRange As Range
Dim LastRow As Long
Dim FormulaCells As Range
Dim Test As Long
Dim WS As Worksheet
Dim PrecCell As Range

If IsMissing(WorksheetName) = True Then
    Set WS = ActiveSheet
Else
    On Error Resume Next
    Set WS = ActiveWorkbook.Worksheets(WorksheetName)
    If Err.Number <> 0 Then
        '''''''''''''''''''''''''''''''
        ' Invalid worksheet name.
        '''''''''''''''''''''''''''''''
        Exit Sub
    End If
End If
    

If Application.WorksheetFunction.CountA(WS.UsedRange.Cells) = 0 Then
    ''''''''''''''''''''''''''''''
    ' Worksheet is blank. Get Out.
    ''''''''''''''''''''''''''''''
    Exit Sub
End If

''''''''''''''''''''''''''''''''''''''
' Find the last used cell on the
' worksheet.
''''''''''''''''''''''''''''''''''''''
Set Rng = WS.Cells.Find(what:="*", after:=WS.Cells(WS.Rows.Count, WS.Columns.Count), lookat:=xlPart, _
    searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False)

LastRow = Rng.Row

Set RefColl = New Collection

'''''''''''''''''''''''''''''''''''''
' We go from bottom to top to keep
' the references intact, preventing
' #REF errors.
'''''''''''''''''''''''''''''''''''''
For RowNum = LastRow To 1 Step -1
    Set FormulaCells = Nothing
    If Application.WorksheetFunction.CountA(WS.Rows(RowNum)) = 0 Then
        ''''''''''''''''''''''''''''''''''''
        ' There are no non-blank cells in
        ' row R. See if R is in the RefColl
        ' reference Collection. If not,
        ' add row R to the DeleteRange.
        ''''''''''''''''''''''''''''''''''''
        On Error Resume Next
        Test = RefColl(CStr(RowNum))
        If Err.Number <> 0 Then
            ''''''''''''''''''''''''''
            ' R is not in the RefColl
            ' collection. Add it to
            ' the DeleteRange variable.
            ''''''''''''''''''''''''''
            If DeleteRange Is Nothing Then
                Set DeleteRange = WS.Rows(RowNum)
            Else
                Set DeleteRange = Application.Union(DeleteRange, WS.Rows(RowNum))
            End If
        Else
            ''''''''''''''''''''''''''
            ' R is in the collection.
            ' Do nothing.
            ''''''''''''''''''''''''''
        End If
        On Error GoTo 0
        Err.Clear
    Else
        '''''''''''''''''''''''''''''''''''''
        ' CountA > 0. Find the cells
        ' containing formula, and for
        ' each cell with a formula, find
        ' its precedents. Add the row number
        ' of each precedent to the RefColl
        ' collection.
        '''''''''''''''''''''''''''''''''''''
        If IsRowClear(RowNum:=RowNum) = True Then
            '''''''''''''''''''''''''''''''''
            ' Row contains nothing but blank
            ' cells or cells with only an
            ' apostrophe. Cells that contain
            ' only an apostrophe are counted
            ' by CountA, so we use IsRowClear
            ' to test for only apostrophes.
            ' Test if this row is in the
            ' RefColl collection. If it is
            ' not in the collection, add it
            ' to the DeleteRange.
            '''''''''''''''''''''''''''''''''
            On Error Resume Next
            Test = RefColl(CStr(RowNum))
            If Err.Number = 0 Then
                ''''''''''''''''''''''''''''''''''''''
                ' Row exists in RefColl. That means
                ' a formula is referencing this row.
                ' Do not delete the row.
                ''''''''''''''''''''''''''''''''''''''
            Else
                If DeleteRange Is Nothing Then
                    Set DeleteRange = WS.Rows(RowNum)
                Else
                    Set DeleteRange = Application.Union(DeleteRange, WS.Rows(RowNum))
                End If
            End If
        Else
            On Error Resume Next
            Set FormulaCells = Nothing
            Set FormulaCells = WS.Rows(RowNum).SpecialCells(xlCellTypeFormulas)
            On Error GoTo 0
            If FormulaCells Is Nothing Then
                '''''''''''''''''''''''''
                ' No formulas found. Do
                ' nothing.
                '''''''''''''''''''''''''
            Else
                '''''''''''''''''''''''''''''''''''''''''''''''''''
                ' Formulas found. Loop through the formula
                ' cells, and for each cell, find its precedents
                ' and add the row number of each precedent cell
                ' to the RefColl collection.
                '''''''''''''''''''''''''''''''''''''''''''''''''''
                On Error Resume Next
                For Each Rng In FormulaCells.Cells
                    For Each Prec In Rng.Precedents.Cells
                        RefColl.Add Item:=Prec.Row, key:=CStr(Prec.Row)
                    Next Prec
                Next Rng
                On Error GoTo 0
            End If
        End If
        
    End If
    
    '''''''''''''''''''''''''
    ' Go to the next row,
    ' moving upwards.
    '''''''''''''''''''''''''
Next RowNum


''''''''''''''''''''''''''''''''''''''''''
' If we have rows to delete, delete them.
''''''''''''''''''''''''''''''''''''''''''

If Not DeleteRange Is Nothing Then
    DeleteRange.EntireRow.Delete shift:=xlShiftUp
End If

End Sub
Function IsRowClear(RowNum As Long) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''
' IsRowClear
' This procedure returns True if all the cells
' in the row specified by RowNum as empty or
' contains only a "'" character. It returns False
' if the row contains only data or formulas.
''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ColNdx As Long
Dim Rng As Range
ColNdx = 1
Set Rng = Cells(RowNum, ColNdx)
Do Until ColNdx = Columns.Count
    If (Rng.HasFormula = True) Or (Rng.Value <> vbNullString) Then
        IsRowClear = False
        Exit Function
    End If
    Set Rng = Cells(RowNum, ColNdx).End(xlToRight)
    ColNdx = Rng.Column
Loop

IsRowClear = True

End Function

Este código, DeleteBlankRows, excluirá uma linha, se ela estiver toda em branco. Apagará a linha inteira se uma célula na coluna especificada estiver em branco. Somente a coluna marcada, outras serão ignoradas.

CÓDIGO:

Public Sub DeleteRowOnCell() 

         On Error Resume Next 

         Selection.SpecialCells (xlCellTypeBlanks). EntireRow.Delete 

         ActiveSheet.UsedRange 

End Sub

Para usar este código, selecione um intervalo de células por colunas e, em seguida, execute o código. Se a célula na coluna estiver em branco, a linha inteira será excluída. Para processar toda a coluna, clique no cabeçalho da coluna para selecionar a coluna inteira.

Este código eliminará as linhas duplicadas em um intervalo. Para usar, selecione uma coluna como intervalo de células, que compreende o intervalo de linhas duplicadas a serem excluídas. Somente a coluna selecionada é usada para comparação. 

CÓDIGO: 

Sub DeleteDuplicateRows Pública () 
''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''' 
'DeleteDuplicateRows 
"Isto irá apagar registros duplicados, com base na coluna ativa. Ou seja, 
"se o mesmo valor é encontrado mais de uma vez na coluna activa, mas todos 
"os primeiros (linha número mais baixo) serão excluídos. 
" 
'Para executar a macro, selecione a coluna inteira que você deseja escanear 
'duplica e executar este procedimento. 
'''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''' 

R Dim As Long 
Dim N Long 
V Variant Dim 
Dim Rng Gama 

On Error GoTo EndMacro 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 


Set Rng = Application.Intersect (ActiveSheet.UsedRange, _ 
ActiveSheet.Columns (ActiveCell.Column)) 

Application.StatusBar = "Processamento de Linha:" & Format (Rng.Row , "#,## 0 ") 

N = 0 
para R = Rng.Rows.Count To 2 Step -1 
Se Mod R 500 = 0 Then 
Application.StatusBar = "Linha de processamento:" & Format (R ", # # 0 ") 
End If 

= Rng.Cells (R, 1). Valor V 
'''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''' 
Nota "que COUNTIF obras estranhamente com uma variante que é igual a vbNullString. 
" Ao invés de passar na variante, você precisa passar vbNullString explicitamente. 
''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''' 
Se V = vbNullString Então 
Se Application.WorksheetFunction. CONT.SE (Rng.Columns (1), vbNullString)> 1 Então 
Rng.Rows (R). EntireRow.Delete 
N = N + 1 
End If 
Else 
Se Application.WorksheetFunction.CountIf (Rng.Columns (1), V)> 1 Então, 
(R). Rng.Rows EntireRow.Delete 
N = N + 1 
End If 
End If 
Next R 

EndMacro: 

Application.StatusBar = False 
Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 
MsgBox "Duplicar linhas excluídas:" & CStr (N ) 

End Sub


Reference:

Inspiration:

André Luiz Bernardes

Tags: VBA, delete, row, blank, cell, duplicate

VBA Excel - Excluindo Abas onde não tem qualquer conteúdo - Delete/Remove Blank/Empty Worksheets

| Blog Office VBA | Blog Excel | Blog Access |

Sub DeleteBlankSheets()

    Dim sh As Variant

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

On Error GoTo Exits:

    For Each sh In Sheets

'IsChart checks, if sh is a Chart Object or some other object.

        If Not IsChart(sh) Then

'CountA checks if there is any data in cells of the sheet

            If Application.WorksheetFunction.CountA(sh.Cells) = 0 Then sh.Delete

        End If

    Next sh

Exits:

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

End Sub

Function IsChart As Boolean

    Dim tmpChart As Chart

    On Error Resume Next

    Set tmpChart = Charts(sh.Name)

    IsChart = IIf(tmpChart Is Nothing, False, True)

End Function

Reference:

Tags: VBA, aba, worksheet, delete, excluindo, blank, empty, sheet

VBA Excel – Eficiência para deletar milhões de linhas

Termo de Responsabilidade 

Caso necessite deletar aquelas planilhas com milhares de linhas em branco poderá usar a funcionalidade abaixo (método primitivo, mais funcional).

Function EliminateThousandBlankLines(StarLine as Long)

' Author: André Luiz Bernardes.

'    Date: 05.02.2009[/color]

Let nRow = StartLine

    Do While ActiveSheet.Cells(nRow, 1) <> ""

        If ActiveSheet.Cells(nRow, 1).Value <> strUserName Then

            ActiveSheet.Rows(nRow).EntireRow.Delete

        Else

            Let nRow = nRow + 1

        End If

    Loop

End Function

Referências: 

Tags: VBA, Excel, blank, delete, row, line, clean