Excel VBA 4ステップマクロは最後のステップを実行しません - 範囲エラー

Question

私は以下を実行したいいくつかのクエリで構成されていますが、最後のものに到達すると削除されません誰でもこれを手助けできますか？

望ましい行動： その後、中央のサイズを変更し、すべてのシートを検索し、単語は「完成任意の行を削除次に、テキスト を折り返す次に表 としてそれをフォーマットすると、最初の行 フリーズ複数のシート 上のいくつかのデータを取ります"存在する。

特定の問題：最終的に（完成単語を持つすべての行を削除する）ステップ が実際にそれを述べることによって行rDelete.EntireRow.Deleteに誤るれた「範囲エラー」

をやっていなかったように見え 再現する最短コード： 私は以下のコードは最後のマクロを除くすべてのコードを削除する以外は最短コードだと思いますが、結果を再現しようとすると他のエラーが発生するかどうかはわかりません。

これは、下記のMatのマグのコメントに対応しており、最小、完全、および検証可能な例に沿っています。

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がそれを好まない。同じ行の複数のセルに「Completed」という単語がある場合は、rDelete.EntireRow.Deleteとオーバーラップします。 「Complete」を持つ各セルの結合を作成する代わりに、各ROWの結合を簡単に作成する必要があります。

これは最終的に組合A1とA1（又はいずれかの行）に試みをもたらし、作​​成されないこの

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

に

Set rDelete = Application.Union(rDelete, rFind)

を変更することにより容易に行うことができますrDeleteの範囲で複製された参照。