Sub Del_Array_SubStr()
     Dim sSubStr As String    'èñêîìîå ñëîâî èëè ôðàçà
     Dim lCol As Long    'íîìåð ñòîëáöà ñ ïðîñìàòðèâàåìûìè çíà÷åíèÿìè
     Dim lLastRow As Long, li As Long
     Dim avArr, lr As Long
   
     lCol = Val(InputBox("D", "Çàïðîñ ïàðàìåòðà", 4))
     If lCol = 0 Then Exit Sub
     Application.ScreenUpdating = 0
     lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
     'Имя листа с диапазоном значений на удаление
    Sheets ("Лист2")
         avArr = .Range(.Cells(1, 3), .Cells(.Rows.Count, 1).End(xlUp))
     End With
     'óäàëÿåì
     For lr = 1 To UBound(avArr, 1)
         sSubStr = avArr(lr, 1)
         For li = lLastRow To 1 Step -1
             'If CStr(Cells(li, lCol)) = sSubStr Then Rows(li).Delete
             If -(InStr(Cells(li, lCol), sSubStr) > 0) <> lMet Then Rows(li).Delete
         Next li
     Next lr
     Application.ScreenUpdating = 1
End Sub