Sub replace_substr()
Dim arr As Variant, i As Long, pattern As String

arr = Application.InputBox("выберите диапазон для замены(например А1:B10)", Type:=8) ' заносим диапазон в массив (Type:=8 означает объект-диапазон)

With CreateObject("VBScript.Regexp") ' объект-регулярные выражения
    
    .Global = False: .MultiLine = False: .IgnoreCase = False
    .pattern = Application.InputBox("введите слово для поиска и замены", Type:=2) ' спрашиваем строку для поиска в столбце A (Type:=2 означает объект-строку)
    
    For i = LBound(arr, 1) To UBound(arr, 1) ' проходим циклом по массиву и если совпадение надено, то
        If .test(arr(i, 1)) Then ActiveSheet.Cells(i, 2).ClearContents ' очищаем ячейку в столбце B
    Next i
    
End With
End Sub


For s = 2 To iLastRow
If Cells(s, 1) Like "*яблоки*" Then Cells(s, 2).Clear
Next s

If InStr(Cells(s, 1), "яблоки") Then Cells(s, 2).Clear