運行時錯誤424 - 所需的對象

Question

我有這個非常簡單的VBA代碼，我用它來查找列中的某些文本並擦除整行。但由於某種原因，我每次運行它給我這個錯誤：運行時錯誤'424'：所需的對象

任何線索？

Sub DeleteText() 
    Dim c As Range 
    Dim sArray(1 To 4) As String 
    sArray(1) = "TEXT 1" 
    sArray(2) = "TEXT 2" 
    sArray(3) = "TEXT 3" 
    sArray(4) = "TEXT 4" 
    Dim SrchRng 

    Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp)) 

    For i = 1 To 4 

    Do 
     Set c = SrchRng.Find(What:=sArray(i), LookIn:=xlValues) ' <-- IT STOPS IN THIS LINE 
     If Not c Is Nothing Then c.EntireRow.Delete 
    Loop While Not c Is Nothing 
    Next i 
End Sub 

Answer 1

當你刪除你改變什麼行SrchRng點：最終你可以得到你已經刪除了所有的細胞的點，所以它不再是一個有效的範圍內引用。一旦你達到這一點，任何對SrchRange的引用都會引發錯誤。

你可以只收集要刪除的行，你循環，然後刪除它們全都在結尾處：

Sub DeleteText() 

    Dim c As Range 
    Dim sArray(1 To 4) As String, i As Long 
    sArray(1) = "TEXT 1" 
    sArray(2) = "TEXT 2" 
    sArray(3) = "TEXT 3" 
    sArray(4) = "TEXT 4" 
    Dim SrchRng As Range, rngDelete As Range 

    Set SrchRng = ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp)) 

    For i = 1 To 4 

    Do 
     'NOTE: use LookAt to ensure you're not making a partial match 
     ' Unless you want that... 
     Set c = SrchRng.Find(What:=sArray(i), LookIn:=xlValues, lookat:=xlWhole) 
     If Not c Is Nothing Then 
      c.Value = "" '<< so it's not found again 
      'build up a range of cells to delete 
      If rngDelete Is Nothing Then 
       Set rngDelete = c 
      Else 
       Set rngDelete = Application.Union(c, rngDelete) 
      End If 
     End If 
    Loop While Not c Is Nothing 
    Next i 

    'delete any found rows 
    If Not rngDelete Is Nothing Then rngDelete.EntireRow.Delete 

End Sub