Excel VBA 4步宏未執行最后一步 - 范圍錯誤

Question

我有下面的幾個查詢，我想按順序運行，但似乎當我到達最后一個它不刪除（由於刪除本身工作）任何人都可以幫忙嗎？

期望的行為：在多張紙上獲取一些數據然后凍結第一行然后將其格式化為表然后調整大小，居中並換行文本然后搜索所有工作表並刪除存在單詞“completed”的任何行。

具體問題：它似乎沒有做最后一步（刪除所有行已完成的單詞）實際上它在行rrdlete.EntireRow.Delete錯誤地指出“范圍錯誤”

最短代碼重現：我認為下面是最短的代碼，除了消除除最后一個宏以外的所有代碼，但我不確定在嘗試重現結果時是否會產生其他錯誤。

希望這可以解決下面的Mat's Mug的評論，並且與最小，完整和可驗證的示例一致。

Sub TEST()
'
' Freeze_Panes Macro
'
' This one Freezes Row 1 (under Header)
    Dim s As Worksheet
    Dim c As Worksheet
' store current sheet
    Set c = ActiveSheet
' Stop flickering...
    Application.ScreenUpdating = False
' Loop throught the sheets
    For Each s In ActiveWorkbook.Worksheets

' Have to activate - SplitColumn and SplitRow are properties of ActiveSheet
    s.Activate

    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
'   .SplitRow = 2 'Depending on if it has a header maybe?
        .FreezePanes = True
    End With

    Next
' Back to original sheet
    c.Activate
    Application.ScreenUpdating = True

    Set s = Nothing
    Set c = Nothing
Call Format_As_Table
End Sub
Private Sub Format_As_Table()
'
' Format_As_Table Macro
'
' Declaration
Dim Tbl As ListObject
Dim Rng As Range
Dim sh As Worksheet

Application.ScreenUpdating = False
' Loop Through All Sheets and Format All Data as Table, then Orient as Landscape
For Each sh In ActiveWorkbook.Sheets
    With sh
        Set Rng = .Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell))
        Set Tbl = .ListObjects.Add(xlSrcRange, Rng, , xlYes)
        Tbl.TableStyle = "TableStyleMedium15"

        .PageSetup.Orientation = xlLandscape
    End With

Next sh
Application.ScreenUpdating = False
Call Resize_Columns_And_Rows_No_Header
End Sub
Private Sub Resize_Columns_And_Rows_No_Header()
'
'Resize_Columns_And_Rows Macro
'
'Declaration
  Dim wkSt As String
  Dim wkBk As Worksheet
  Dim temp As Variant
  Dim lastCol As Long

  wkSt = ActiveSheet.Name
' This Loops Through All Sheets
  For Each wkBk In ActiveWorkbook.Worksheets
      On Error Resume Next
      wkBk.Activate
      lastCol = wkBk.Cells(1, Columns.Count).End(xlToLeft).Column
'This is only needed if you are wrapping the text
      wkBk.Rows.WrapText = True
'This is to center align all rows
      'wkBk.Rows.VerticalAlignment = xlCenter
      wkBk.Rows.HorizontalAlignment = xlCenter
'Resize Columns due to size
      wkBk.Columns("F:F").ColumnWidth = 50
      wkBk.Columns("G:G").ColumnWidth = 50
' Resize Rows
      wkBk.Rows.EntireRow.AutoFit
' Resize Columns
      wkBk.Columns.EntireColumn.AutoFit
  Next wkBk
  Sheets(wkSt).Select
Call TestDeleteRows
End Sub

Private Sub TestDeleteRows()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String
Dim sFirstAddress As String
Dim sh As Worksheet

strSearch = "Completed"
Set rDelete = Nothing

Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Sheets
With sh.Columns("A:AO")
Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then
    sFirstAddress = rFind.Address
    Do
        If rDelete Is Nothing Then
            Set rDelete = rFind
        Else
            Set rDelete = Application.Union(rDelete, rFind)
        End If
        Set rFind = .FindNext(rFind)
    Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress

    rDelete.EntireRow.Delete
    Set rDelete = Nothing
End If
End With
Next sh
Application.ScreenUpdating = False
End Sub

Answer 1

您似乎已經在評論中找到了解決方案。 但是，我只是想提到以下內容：

當您重疊選擇並嘗試刪除它們時，Excel不喜歡它。 如果在同一行的多個單元格中有“已完成”一詞，則最終會與rDelete.EntireRow.Delete重疊。 您應該簡單地創建每個ROW的並集，而不是創建具有“完成”的每個單元格的並集。

這可以通過改變輕松完成

Set rDelete = Application.Union(rDelete, rFind)

至

Set rDelete = Application.Union(rDelete, Range("A" & rFind.Row))

這最終會導致嘗試將A1與A1（或任何一行）聯合起來，並且不會在rDelete范圍內創建重復引用。