[c18].value=ucase([c18].value)

Sub Мяу()
    Dim objRegExp As Object, oMatches As Object, ar(), i&
    Dim s$, cl As Range
    Set cl = [c18]
    s = cl.Value
    Set objRegExp = CreateObject("VBScript.RegExp")
    With objRegExp
        .Global = True: .IgnoreCase = True: .MultiLine = False
        .Pattern = [d16].Value
        If .test(s) Then
            Set oMatches = .Execute(s)
            ReDim ar(1 To oMatches.Count, 1 To 2)
            For i = 0 To oMatches.Count - 1
                ar(i + 1, 1) = oMatches(i).firstindex + 1
                ar(i + 1, 2) = oMatches(i).Length
            Next
            s = .Replace(s, ConvertRegistr(oMatches(1), 1))
            cl.Value = s
            For i = 1 To UBound(ar)
                cl.Characters(ar(i, 1), ar(i, 2)).Font.ColorIndex = 3
            Next
        End If
    End With
End Sub

Sub Мяу()
    Dim objRegExp As Object, oMatches As Object, ar(), i&
    Dim s$, cl As Range
    Set cl = [c18]
    s = cl.Value
    Set objRegExp = CreateObject("VBScript.RegExp")
    With objRegExp
        .Global = True: .IgnoreCase = True: .MultiLine = False
        .Pattern = "([^а-яёa-z]|^)" & [d16].Value & "([^а-яёa-z]|$)"
        If .test(s) Then
            Set oMatches = .Execute(s)
            ReDim ar(1 To oMatches.Count, 1 To 2)
            For i = 0 To oMatches.Count - 1
                ar(i + 1, 1) = oMatches(i).firstindex + 1 - CLng(Len(oMatches(i).subMatches(0)) > 0)
                ar(i + 1, 2) = oMatches(i).Length - Len(oMatches(i).subMatches(0)) - Len(oMatches(i).subMatches(1))
                Mid(s, oMatches(i).firstindex + 1, oMatches(i).Length) = ConvertRegistr(oMatches(i), 4)
            Next
            cl.Value = s
            For i = 1 To UBound(ar)
                cl.Characters(ar(i, 1), ar(i, 2)).Font.ColorIndex = 3
            Next
        End If
    End With
End Sub