Excel VBA 4步macros未执行最后一步 – 范围错误

我有下面是由几个查询,我想要按顺序运行,但似乎当我到最后一个它不会删除(本身删除工程)任何人都可以帮助吗?

希望的行为:在多张纸上取一些数据然后冻结第一行然后格式化为表格然后resize,居中和换行文字然后search所有的纸张并删除“已完成”一词存在的任何行。

具体问题:它似乎没有进行最后一步(删除所有行的单词已完成)实际上,它是错误的行rDelete.EntireRow.Delete通过声明“范围错误”

最短的代码重现:我认为下面是最短的代码,除了只消除最后一个macros,但我不确定这是否会创build其他错误,当试图重现结果。

希望这可以解决下面的Mat's Mug's Comment,并符合Minimal,Complete和Verifiable的例子。

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 

你似乎已经在评论中制定了一个解决scheme。 不过,我只是想我会提到以下几点:

当你重叠select并尝试删除它们时,Excel不喜欢它。 如果在同一行的多个单元格中有“已完成”一词,则最终会与rDelete.EntireRow.Delete重叠。 而不是创build具有“完整”的每个单元格的联合,您应该简单地创build每个行的联合。

这可以通过更改轻松完成

Set rDelete = Application.Union(rDelete, rFind)

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

这最终导致尝试将A1与A1(或其中任何一行)联合起来,并且不会在rDelete范围内创build重复的引用。