Подправить(доработать) код VBA для Excel

gistfile1.txt

Function RegExpReplace(ByVal WhichString As String, _
                        ByVal Pattern As String, _
                        ByVal ReplaceWith As String, _
                        Optional ByVal IsGlobal As Boolean = True, _
                        Optional ByVal IsCaseSensitive As Boolean = True) As String
    'Declaring the object
    Dim objRegExp As Object
    'Initializing an Instance
    Set objRegExp = CreateObject("VBScript.RegExp")
    'Setting the Properties
    objRegExp.Global = IsGlobal
    objRegExp.Pattern = Pattern
    objRegExp.IgnoreCase = Not IsCaseSensitive
    objRegExp.MultiLine = True
    'Execute the Replace Method
    RegExpReplace = objRegExp.Replace(WhichString, ReplaceWith)
End Function
 
Sub Пометить_минус_слова()
    Dim sSubStr As String    'искомое слово или фраза
    Dim lCol As Long    'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim avArr, lr As Long
    Dim sCellStr As String
 
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "Запрос параметра", 3))
    If lCol = 0 Then Exit Sub
    Application.ScreenUpdating = 0
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    'Имя листа с диапазоном значений на удаление
    With Sheets("Минус")
        avArr = .Range(.Cells(1, 1), .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
            sCellStr = CStr(Cells(li, lCol))
            sCellStr = CStr(RegExpReplace(sCellStr, "(^|[^a-zA-Zа-яА-Я0-9-]|$)(-[a-zA-Zа-яА-Я0-9-]+)", "", True, False)) ' Удаляем все слова помеченные минусом (заменяем пробелом)
            'If CStr(Cells(li, lCol)) = sSubStr Then Rows(li).Delete
            If InStr(1, CStr(sCellStr), sSubStr, 1) Then Cells(li, lCol).Interior.Color = vbRed
        Next li
    Next lr
    Application.ScreenUpdating = 1
End Sub
 
Function RegExpTest(ByVal WhichString As String, _
                ByVal Pattern As String, _
                Optional ByVal IsGlobal As Boolean = True, _
                Optional ByVal IsCaseSensitive As Boolean = True) As Boolean
 
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = IsGlobal
    objRegExp.IgnoreCase = Not IsCaseSensitive
    objRegExp.Pattern = Pattern
    objRegExp.MultiLine = True
    Set regExp_Matches = objRegExp.Execute(WhichString)
    RegExpTest = (regExp_Matches.Count > 0)
End Function
 
Sub Пометить_минус_слова2()
    Dim sSubStr As String    'искомое слово или фраза
    Dim lCol As Long    'номер столбца с просматриваемыми значениями
    Dim lLastRow As Long, li As Long
    Dim avArr, lr As Long
    Dim sCellStr As String
 
    lCol = Val(InputBox("Укажите номер столбца, в котором искать указанное значение", "Запрос параметра", 3))
    If lCol = 0 Then Exit Sub
    Application.ScreenUpdating = 0
    lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
    'Имя листа с диапазоном значений на удаление
    With Sheets("Минус")
        avArr = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    'удаляем
    For lr = 1 To UBound(avArr, 1)
        sSubStr = avArr(lr, 1)
        ' Формируем строку-шаблон для регулярного выражения
        sSubStr = Replace(sSubStr, "\", "\\")
        sSubStr = "(^|[^a-zA-Zа-яА-Я0-9-]|$)" + sSubStr + "(^|[^a-zA-Zа-яА-Я0-9-]|$)"
        For li = lLastRow To 1 Step -1
            sCellStr = CStr(Cells(li, lCol))
            sCellStr = CStr(RegExpReplace(sCellStr, "(^|[^a-zA-Zа-яА-Я0-9-]|$)(-[a-zA-Zа-яА-Я0-9-]+)", "", True, False)) ' Удаляем все слова помеченные минусом (заменяем пробелом)
            'If CStr(Cells(li, lCol)) = sSubStr Then Rows(li).Delete
            If RegExpTest(CStr(sCellStr), sSubStr, False, False) Then Cells(li, lCol).Interior.Color = vbRed
        Next li
    Next lr
    Application.ScreenUpdating = 1
End Sub