MS Excel – Deletando linhas - 05


Termo de Responsabilidade












Desenvolvi esta solução a partir de várias soluções que poderão consultar depois.

A solução abaixo checa as linhas abaixo da linha 11 (o que poderá customizar), deletando quando encontra a linha totalmente em branco, bem como quando a coluna "C" estiver vazia.

Sub PreparePlan_DelAllBlankRows()
' Author: Date: Contact:
' André Bernardes 23/01/2009 10:17 bernardess@gmail.com
Dim i As Long ' We use Long in case they have over 32.767 rows selected.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = 11 To ActiveSheet.UsedRange.Rows.Count
If Range("C" & i).Value = "" Then 'WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Rows(i).Select
Selection.Delete Shift:=xlUp
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Outro exemplo:


Sub DeleteBlankRows1()
'Deletes the entire row within the selection if the ENTIRE row contains no data.
'We use Long in case they have over 32,767 rows selected.
Dim i As Long
'We turn off calculation and screenupdating to speed up the macro.
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'We work backwards because we are deleting rows.
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub


Mais um exemplo:




Sub DeleteBlankRows2()
'Deletes the entire row within the selection if some of the cells WITHIN THE SELECTION contain no data.
On Error Resume Next
Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0
End Sub


Terceiro exemplo:




Sub DeleteBlankRows3()
'Deletes the entire row within the selection if the ENTIRE row contains no data.
Dim Rw As Range
If WorksheetFunction.CountA(Selection) = 0 Then
MsgBox "No data found", vbOKOnly, "OzGrid.com"
Exit Sub
End If
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
Selection.SpecialCells(xlCellTypeBlanks).Select
For Each Rw In Selection.Rows
If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then
Selection.EntireRow.Delete
End If
Next Rw
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub


Quarto exemplo:




Sub MoveBlankRowsToBottom()
'Assumes the list has a heading
With Selection
.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End With
End Sub
Sub DeleteRowsBasedOnCriteria()
'Assumes the list has a heading.
With ActiveSheet
If .AutoFilterMode = False Then .Cells(1, 1).AutoFilter
.Range("A1").AutoFilter Field:=1, Criteria1:="Delete"
.Range("A1").CurrentRegion.Offset(1, 0).SpecialCells _
(xlCellTypeVisible).EntireRow.Delete
.AutoFilterMode = False
End With
End Sub


5º exemplo:




Sub DeleteRowsWithSpecifiedData()
'Looks in Column D and requires Column IV to be clean
Columns(4).EntireColumn.Insert
With Range("D1:D" & ActiveSheet.UsedRange.Rows.Count)
.FormulaR1C1 = "=IF(RC[1]="""","""",IF(RC[1]=""Not Needed"",NA()))"
.Value = .Value
On Error Resume Next
.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End With
On Error GoTo 0
Columns(4).EntireColumn.Delete
End Sub



TagsExcel, Column, Coluna, Delete, Linha, Plan, Planilhas, Report, Row,  rows,worksheet, lines



André Luiz Bernardes
A&A® - In Any Place.


Nenhum comentário:

Postar um comentário

diHITT - Notícias