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

問題は、シートで使用されている範囲に Excel シートの上から下まで、つまり行 1 から行 1048756 までの列全体が含まれていないため、プロパティとしてUsedRange受け入れられないことです。Range("A:A")

代わりに、次のよう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

以下のコードを試してください

   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