vba - 如何删除所有空白行

Question

此代码使 Excel 无响应。有谁知道为什么会这样？

Sub delblank()
On Error Resume Next
ActiveSheet.UsedRange.Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
If Err Then
MsgBox "No blank cells"
End If
End Sub

Answer 1

问题是它UsedRange不会被接受Range("A:A")为属性，因为工作表中使用的范围不包含 Excel 工作表从上到下的整个列，即从第 1 行到第 1048756 行。

您想要的是引用UsedRange: 的第一列替换Range("A:A")为，Columns(1)如下所示：

ActiveSheet.UsedRange.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

现在它起作用了。

当你有一长串的方法和属性给你带来这样的麻烦时，为了找到错误的根源，将它分解成它的组成部分会更容易。这就是我所做的：

Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim sh As Worksheet

Set sh = ActiveSheet
Set r1 = sh.UsedRange
Set r2 = r1.Range("A:A") ' Aha, error occurs here! Wow, that was easy to find.
Set r3 = r1.SpecialCells(xlCellTypeBlanks)
r3.EntireRow.Delete

错误消失后，可以将链条重新组合在一起以消除混乱。

On Error Resume Next除非你绝对确定这是你想要的，否则不要使用，因为它只会吞下错误而不告诉你它们来自哪里。

Answer 2

尝试这样的事情：

Public Sub Tester()
On Error Resume Next
Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0
End Sub

Answer 3

试试下面的代码

   Sub delblank()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim rng As Range
    On Error Resume Next
    Set rng = ActiveSheet.UsedRange.Range("A:A").SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "No cells found"
    Else
        rng.EntireRow.Delete
    End If

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub