Sub Main()
Const 赤色文字 As Byte = 3
Const 青色文字 As Byte = 5
Const 黄色文字 As Byte = 6
Const 赤色塗潰 As Byte = 3
Const 青色塗潰 As Byte = 5
Const 黄色塗潰 As Byte = 6
Const 無色塗潰 As Byte = 0
Const 太字にする As Boolean = True
Const 太字にしない As Boolean = False
Call HighlightTexts("目立たせたい文字を入力", Selection, 赤色文字, 太字にする, 無色塗潰)
End Sub
Sub HighlightTexts _
(targetString As String, _
 selectedCells As Range, _
 Optional charColor As Byte = 3, Optional charBold As Boolean = True, Optional cellColor As Byte = 0)
    Dim cell As Range
    Dim startStr As Integer
    Dim textLength As Integer
    textLength = Len(targetString)
    For Each cell In selectedCells
        startStr = InStr(cell.Value, targetString)
        If startStr <> 0 Then
            cell.Interior.ColorIndex = cellColor
        End If
        Do While startStr > 0
            With cell.Characters(Start:=startStr, Length:=textLength).Font
                .ColorIndex = charColor
                .Bold = charBold
                
            End With
            startStr = InStr(startStr + 1, cell.Value, targetString)
        Loop
    Next cell
End Sub