Question

我的下面是几个我想要按顺序运行的查询，但是当我到达最后一个它不会删除时（删除本身就可以了）可以任何人帮忙此？

所需行为：在多张纸上获取一些数据然后冻结第一行然后将其格式化为表格然后调整大小，居中和包装文本然后搜索所有工作表并删除单词＆＃34;已完成的任何行＆＃34;存在。

具体问题：它似乎没有做最后一步（删除所有行已完成的单词）实际上它在行rrdle.EntireRow.Delete错误地指出＆＃34;范围错误＆＃34;

最短代码重现：我认为下面是最短的代码，除了消除除最后一个宏以外的所有代码，但我不确定在尝试重现结果时是否会产生其他错误。

希望这可以在下面的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不喜欢它。如果你有'＃34;已完成＆＃34;在同一行的多个单元格中，最终会与rDelete.EntireRow.Delete重叠。而不是创建具有＆＃34;完成＆＃34;的每个单元格的并集。你应该简单地创建每个ROW的联合。

这可以通过更改

轻松完成

Set rDelete = Application.Union(rDelete, rFind)

到

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

这最终会导致尝试将A1与A1（或任何一行）结合使用，并且不会在rDelete范围内创建重复引用。

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

1 个答案: