列コードの行を削除する

Question

データセットからアイテムを削除しようとしています。 基本的には「B：V列に行き、私のパラメータを探して、その値が列にあれば、行を削除してください」

残念ながら、このコードは機能しません。 。

自分自身を私が1列でループを行うためのコードを壊す試みたが、そのコードが完了するまでに長いへの道を取っていた、私は、より高速なデータを削除した可能性があります。

任意の考え？

Sub SellThrough_dataManip() 
    Dim rCell As Range 
    Dim strAddress As String 

    Application.ScreenUpdating = False 

    With ActiveSheet.Columns("B:V") 
     Set rCell = .Find(What:="Check" & "CNL" & "TENA" & "cancelled" & "N" & "Z" & "R" & "Y" & "Club" & "#N/A", LookIn:=xlValues, SearchOrder:=xlByColumns) 

     If Not rCell Is Nothing Then 
      Do 
       strAddress = rCell.Address 
       rCell.EntireRow.Delete 
       Set rCell = .FindNext(Range(strAddress)) 
      Loop Until rCell Is Nothing 
     End If 

    End With 

End Sub 

Answer 1

削除する範囲を増やしてみるループ内で編、その後1ですべてを削除するには、単語「CheckCNLTENAcancelledNZRYClub＃N/A」を探している

Sub SellThrough_dataManip() 
    Dim rCell As Range, DelRng As Range 
    Dim FirstAddress As String 

    Application.ScreenUpdating = False 

    With ActiveSheet.Columns("B:V") 
     Set rCell = .Find(What:="Check" & "CNL" & "TENA" & "cancelled" & "N" & "Z" & "R" & "Y" & "Club" & "#N/A", LookIn:=xlValues, SearchOrder:=xlByColumns) 

     If Not rCell Is Nothing Then 
      FirstAddress = rCell.Address 
      Do 
       If DelRng Is Nothing Then 
        Set DelRng = rCell 
       Else 
        Set DelRng = Union(DelRng, rCell) 
       End If 
       Set rCell = .FindNext(rCell) 
      Loop While Not rCell.Address = FirstAddress 
     End If 
    End With 
    If Not DelRng Is Nothing Then DelRng.EntireRow.Delete 
End Sub