删除空行

时间:2013-04-10 08:18:48

标签: excel vba

我有一个Excel宏,它删除Excel工作表中的所有空行。这个宏需要很长时间才能完成。文件自动生成,每个文件都需要运行此宏。宏在检查其值后一次删除一行。

我需要这样的东西:

If  rowValue = "" then
    deleteThisRow And deleteAll Subsequent rows at once
End If

这是我现在使用的代码:

Sub RemoveRows()
    Range("A8").Select 
    Dim checkval 
    Dim RowAmount
    RowAmount = 93

    Do
        checkval = ActiveCell.Value
        If (checkval = "") Then
            ActiveCell.EntireRow.Delete
        Else
            ActiveCell.Offset(1, 0).Select
        End If
        RowAmount = RowAmount - 1
    Loop While RowAmount > 0
End Sub

2 个答案:

答案 0 :(得分:1)

您想要在一次操作中删除所有必要的行就可以了。另外,避免Select并避免在一系列单元格上循环也会加快速度。

这是一种适合你的方法

Sub Demo()
    Dim sh As Worksheet
    Dim rng As Range
    Dim rngBlanks As Range

    ' Get a reference to the sheet you want to process
    Set sh = ActiveSheet

    ' Get a reference to the range of cells to test
    With sh
        Set rng = .Range(.Cells(8, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With

    ' if there are no blanks SpecialCells will error, so handle it
    On Error Resume Next
    ' Reduce rng to reference only blank cells
    Set rngBlanks = rng.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0

    ' see if there are any blanks
    If Not rngBlanks Is Nothing Then
        ' delete all of them
        rngBlanks.EntireRow.Delete
    End If
End Sub

根据提供的其他信息进行更新:“空白”单元格可能包含返回空字符串的公式。

以下是使用AutoFilter

的方法
Sub Demo()
    Dim sh As Worksheet
    Dim rng As Range
    Dim rngBlanks As Range

    Application.ScreenUpdating = False
    ' Get a reference to the sheet you want to process
    Set sh = ActiveSheet

    ' Get a reference to the range of cells to test, plus header row
    With sh
        Set rng = .Range(.Cells(7, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With

    ' Apply filr to hide non-empty cells
    sh.AutoFilterMode = False
    rng.AutoFilter Field:=1, Criteria1:="=", VisibleDropDown:=True

    ' if there are no blanks SpecialCells will error, so handle it
    On Error Resume Next
    ' Reduce rng to reference only blank cells, exclude header row
    Set rngBlanks = rng.Offset(1, 0).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    ' see if there are any blanks
    If Not rngBlanks Is Nothing Then
        ' delete all of them
        rngBlanks.EntireRow.Delete
    End If

    sh.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

答案 1 :(得分:0)

所以基本上,如果遇到一个空行,它应该删除该行及其下面的所有行。

为了删除下面的所有行,你基本上可以做同样的事情,当你按下CTRL和向下箭头时 - 它会转到下一个值(如果有一个,在你的情况下,它听起来像那里不会是)或到最后(第65536行是我遇到的所有Excel版本的限制)。这将是......

Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp

这将从您选择的行(因此无需删除它),到下一个值或结束,并删除所有这些行。

编辑 - 整个宏:

Dim i As Integer
For i = 1 To 93
    Range("A" & i).Select
    Dim CheckVal As String
    CheckVal = ActiveCell.Value
    If (CheckVal = "") Then
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Delete Shift:=xlUp
    End If
Next i

请记住,如果在找到的第一个“空白”下面有任何值,它们也会被删除为第一个连续值。