VBAで特定の文字に赤色を追加

質問

いつもお世話になります。
WINDOWS XP EXCELL2003 です。
「公　、有」という２文字に赤色の文字を条件書式で対応しようとしましたがすでに３通りを
設定しているため下記のマクロで、

If Target.Value = 5 Then Target.Value = "有"
If Target.Value = 6 Then Target.Value = "公"

　の２つの文字のみに赤色のフォントにするための記述を追加したいのですが
お知恵を拝借できませんか。
ご指導よろしくお願いします。

ご参考に現在使用のマクロです。

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("I13:AM27")) Is Nothing Then Exit Sub

Application.EnableEvents = False

If Target.Value = 0 Then Target.Value = Empty
If Target.Value = 1 Then Target.Value = "日"
If Target.Value = 2 Then Target.Value = "△"
If Target.Value = 3 Then Target.Value = "▼"
If Target.Value = 4 Then Target.Value = "夜"
If Target.Value = 5 Then Target.Value = "有"
If Target.Value = 6 Then Target.Value = "公"

Application.EnableEvents = True
End Sub

回答No.2

watabe007 · ベストアンサー

With Target
　　If Intersect(Target, Range("I13:AM27")) Is Nothing Then Exit Sub
　　.Font.ColorIndex = 0
　　Application.EnableEvents = False
　　Select Case .Value
　　　　Case 0: .Value = Empty
　　　　Case 1 To 4
　　　　　　.Value = Choose(.Value, "日", "△", "▼", "夜")
　　　　Case 5 To 6
　　　　　　.Value = Choose(.Value - 4, "有", "公")
　　　　　　.Font.ColorIndex = 3
　　End Select
　　Application.EnableEvents = True
End With

お礼

早速ご回答をいただき誠に有難うございました。
早速試させていただきました結果バッチリでした。
今後ともよろしく御願いします。

回答No.1

watabe007

With Target
　　If Intersect(Target, Range("I13:AM27")) Is Nothing Then Exit Sub
　　.Font.ColorIndex = 0
　　Application.EnableEvents = False
　　Select Case .Value
　　　　Case 0: .Value = Empty
　　　　Case 1: .Value = "日"
　　　　Case 2: .Value = "△"
　　　　Case 3: .Value = "▼"
　　　　Case 4: .Value = "夜"
　　　　Case 5: .Value = "有": .Font.ColorIndex = 3
　　　　Case 6: .Value = "公": .Font.ColorIndex = 3
　　End Select
　　Application.EnableEvents = True
End With