VBA 未找到單元格錯誤 xlCellTypeBlanks

Question

我有以下 Sub 遍歷許多工作表，應該刪除該范圍內的任何空白行。 有時它會正常工作，但有時它會給我一個“未找到單元格錯誤”並失敗。 我不明白為什么。

錯誤出現在Set r = Range("B2:B" & counter).SpecialCells(xlCellTypeBlanks)

我試圖通過使用 if 語句轉到測試錯誤句柄來捕獲此錯誤，但是，通過這樣做，例程不會刪除任何內容，因為 r 當然什么都沒有。

考慮到每次運行宏時空白行可以位於不同的位置，是否有更簡單的方法可以從多個選項卡中刪除空白行。

Sub RemoveBlanks()

Dim ws As Worksheet
Dim counter As Long
Dim r As Range
Dim cell As Range

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "Summary" Then
        ws.Activate
        counter = ws.Range("A" & Rows.Count).End(xlUp).Row
        Set r = Range("B2:B" & counter).SpecialCells(xlCellTypeBlanks)
            If r Is Nothing Then
                GoTo test
            End If
        r.EntireRow.Delete shift:=xlShiftUp
        
    End If
test: Next ws

Worksheets("Summary").Activate

End Sub

Answer 1

用這種方式試試，請：

'your code...
 On Error Resume Next
  Set r = Range("B2:B" & counter).SpecialCells(xlCellTypeBlanks)
 On Error GoTo 0
 If Not r Is Nothing Then  r.EntireRow.Delete shift:=xlShiftUp
'your code...

無論如何，這種方式比范圍的每個單元格之間的迭代更快

Answer 2

如果沒有空白單元格，你會得到一個錯誤，如果有錯誤你可以繼續下一步。

    Sub Button1_Click()
    Dim sh As Worksheet
    
    For Each sh In Sheets
        On Error Resume Next
        If sh.Name <> "Summary" Then
            With sh
                .Range("B2:B" & .Cells(.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
            End With
        End If
    Next
End Sub

Answer 3

當單元格中從來沒有任何數據時， SpecialCells(xlCellTypeBlanks)失敗。 這樣做更安全：

For i = counter To 2 Step -1
   If LenB(Cells(i, 2)) = 0 Then Cells(i, 2).Entirerow.Delete Shift:=xlShiftUp
Next

如果您懷疑單元格中有空格，您可以申請

... LenB(Trim(Cells(i, 2)) ...