Удалить строки из Excel, используя значения из столбца на другом листе?

Функция ПОИСКПОЗ может принимать совпадения с подстановочными знаками, но вам нужно изменить способ определения удаляемых строк. Просто добавьте префикс и суффикс критерия rtem со звездочками (например, Chr(42) ).

Ваш код не удалил более одного вхождения значения критерия. Вероятно, лучше зациклить его, пока не останется совпадений. Поскольку ПОИСКПОЗ возвращает ошибку при несоответствии, лучше полагаться на СЧЁТЕСЛИ для возврата значения больше нуля.

Sub CheckA()
    Dim str As String, a As Long, vSTRs As Variant

    With Worksheets("Exceptions")
        vSTRs = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Value2
    End With

    With Sheets("IR Temp")
        For a = LBound(vSTRs, 1) To UBound(vSTRs, 1)
            If CBool(Len(Trim(CStr(vSTRs(a, 1))))) Then
                str = Chr(42) & vSTRs(a, 1) & Chr(42)
                Do While CBool(Application.CountIf(.Columns(1), str))
                    .Rows(Application.Match(str, .Columns(1), 0)).EntireRow.Delete
                Loop
            End If
        Next a
    End With
End Sub

Это займет немного больше времени, чем определение блока или объединения несмежных строк для удаления, но работа будет выполнена. Отключите переменные среды, такие как обновление экрана и вычисления, чтобы ускорить процесс, когда он заработает в соответствии с вашими потребностями.

Ниже предполагается, что ваш список слов для поиска находится в столбце Sheet2 A, а ваш список для их проверки - это столбец Sheet1 A, начальная строка 2. Может быть более приятный способ, чем вложенный цикл, но здесь у нас есть ваш список слов в массив, проходя по всем ячейкам, которые мы хотим увидеть, содержат ли они одно из слов, и для каждой из этих ячеек, проходя по циклу, чтобы проверить, есть ли там одно из перечисленных слов.

Public Sub testing()

Dim x As Integer
Dim i As Integer
Dim ws As Worksheet
Dim listws As Worksheet
Dim endList As Integer
Dim endR As Integer
Dim arr() As Variant

Set ws = ThisWorkbook.Worksheets("Sheet1")
endR = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Set listws = ThisWorkbook.Worksheets("Sheet2")
endList = listws.Cells(ws.Rows.Count, "A").End(xlUp).Row
arr = listws.Range("A1:A" & endList)

x = 2
While x <= endR
    For i = 1 To UBound(arr, 1)
        If InStr(ThisWorkbook.Worksheets("Sheet1").Cells(x, 1).Value, arr(i, 1)) > 0 Then
            ThisWorkbook.Worksheets("Sheet1").Cells(x, 1).EntireRow.Delete
        End If
    Next i
    x = x + 1
Wend

End Sub