Sub moji_color()
    Dim area As Range, onesell As Range, i As Long
    Dim moji As Long, keyw As String
    '対象範囲と検索文字列
    Set area = Application.InputBox(Prompt:="検索対象をセル範囲してください。", Type:=8)
    keyw = Application.InputBox(Prompt:="色付けるキーワードは?", Type:=2)
    'セル範囲ループ
    For Each onesell In area
        moji = 1
        '1セル毎に文字チェック
        Do While moji <= Len(onesell)
            i = InStr(moji, UCase(onesell), UCase(keyw), 1)
            If i = 0 Then Exit Do
            '見つかったら赤くする
            onesell.Characters(i, Len(keyw)).Font.Color = vbRed
            moji = moji + i
        Loop
    Next
End Sub