(Excel)特定の文字だけ赤字にしたい

質問

エクセルのシート６枚に渡り、複数セルに大量の文字列が入力されています。
その中で、特定の文字だけを一度に赤字にすることはできますか？

マクロ・入力規則・関数・条件付書式など、やり方は問いません。
宜しくお願いします。

例）
・が一つのセルと仮定。「かき」と「けこ」だけを赤字にしたい。

　・あいうえおかきくけこさしすせそ
　・たちつてとなにぬねのかきくけこ
　・はひふへほまみむめもやゆよ
　・かきくけこわをん

回答No.1

dobaken · ベストアンサー

こんにちは。
マクロを作ってみました。
１回に一つの文字列しか出来ませんが試してみてください。

'************************************************
' 処理名：MojiColorConvert
' 概要　：検索文字列の文字色を赤にする。
'************************************************
Sub MojiColorConvert()
Dim vFndWrd As Variant '検索語句を格納する変数
Dim rFndRng As Range '個々のRangeオブジェクトを格納する変数
Dim sFstAdr As String '最初に検索されたせるアドレスを格納する変数
Dim iFndLen As Integer '検索語句の長さを格納する変数
Dim iChrPos As Integer '検索語句の文字位置を格納する変数

'検索語句を入力
vFndWrd = Application.InputBox(Prompt:="検索語句を入力：", Title:="入力", Type:=2)
If vFndWrd = False Or Len(vFndWrd) = 0 Then
Exit Sub
End If

'検索文字列長を格納
iFndLen = Len(vFndWrd)

'検索されたセルをRangeオブジェクトに設定
Set rFndRng = Cells.Find(what:=vFndWrd, LookIn:=xlValues, LookAt:=xlPart)
If (rFndRng Is Nothing) Then
Exit Sub
End If

'最初に検索されたセルアドレスを取得
sFstAdr = rFndRng.Address

'----------------------------------------
'ワークシート内で検索できなくなるまでループ
'----------------------------------------
Do While Not (rFndRng Is Nothing)
'検索開始位置を文頭に設定
iChrPos = 1

'------------------------------------
'セル内に検索文字がなくなるまで繰り返し
'------------------------------------
Do
iChrPos = InStr(iChrPos, rFndRng.Value, vFndWrd, vbTextCompare)

'セルの値のチェック
If iChrPos <> 0 Then
rFndRng.Characters(iChrPos, iFndLen).Font.ColorIndex = 3
iChrPos = iChrPos + iFndLen
End If
Loop Until iChrPos = 0

'次に検索されたセルに移動
Set rFndRng = Cells.FindNext(rFndRng)

'最初に検索したセルアドレスなら、検索は終了
If (rFndRng.Address = sFstAdr) Then
Exit Do
End If
Loop
End Sub

お礼

dobakenさんこんにちは、お返事遅れてすみません。
誰からも反応がなかったので半ば諦めていました^^;
丁寧にマクロを組んで頂き、ありがとうございました！
さっそく使わせていただきます。
ありがとうございます！！