运行时错误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