Excel VBA 4步宏未执行最后一步-范围错误

Question

我有以下内容，由几个查询组成，我想按顺序运行它们，但当我到达最后一个查询时，它似乎无法删除（尽管单独的删除操作可以正常工作），有人能帮忙解决吗？

期望行为： 获取多个工作表上的数据 然后冻结第一行 然后将其格式化为表格 然后调整大小、居中并换行文本 然后搜索所有工作表并删除任何包含单词“completed”的行。

具体问题： 似乎没有执行最后一步（删除所有包含单词“completed”的行） 实际上，它在 rDelete.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

- Defca Trick

---

在TestDeleteRows中添加一个调试信息，查看执行是否进入块。同时尝试删除on error resume next语句，以查看哪行代码会引发异常。 - Barney

你好，当我删除了错误恢复行时，在最后一个运行的宏中，rDelete.EntireRow.Delete这一行抛出了范围错误。 - Defca Trick

寻求调试帮助的问题（“为什么这段代码不起作用？”）必须在问题本身中包括期望的行为、具体的问题或错误以及最短的代码，以便复现。没有清晰的问题陈述对其他读者没有用处。请参见[mcve]。 - Mathieu Guindon

你好，Set rdelete 在多个地方出现，我只需要像下面展示的那样替换1吗？''rDelete.EntireRow.Delete Set rDelete = rDelete.EntireRow rDelete.Delete 'Set rDelete = Nothing - Defca Trick

只需要改变顺序，在将其转换为表之前执行删除操作，这很简单吗？ - Defca Trick

Answer 1

看起来你已经在评论中解决了问题。不过，我想提一下以下内容：

Excel 不喜欢当你重叠选择并尝试删除它们时。如果你在同一行的多个单元格中有单词“Completed”，那么使用 rDelete.EntireRow.Delete 会导致重叠。你应该简单地创建每一行的联合，而不是创建每个包含“Complete”的单元格的联合。

这可以通过将

Set rDelete = Application.Union(rDelete, rFind)

更改为

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

轻松完成。

这最终会尝试将 A1 与 A1（或任何其他行）联合起来，并且不会在范围 rDelete 中创建重复引用。

- HMVBA