EXCEL VBA 1つのセル内の文字に複数色の色指定について

すいませんがEXCEL2013 VBAについてお教えください。
FOR-NEXT等の繰り返し分を使用し一つのセル内の文字に交互に黒赤黒赤と色を塗るVBAを作りたいと考えています。

処理例
※説明用にだいぶ簡略化した記載に直しましたがこんな感じの処理を考えています。


●1回目処理　A1セル
【A】5【B】6
BBBBBBBRRRRRR
※B←黒色R←赤色という意味合いです。

Range("A1").Value = "【A】5"
Range("A1").Value = Range("A1").Value & "【B】6"
Range("A1").Characters(Start:=5, Length:=4).Font.ColorIndex = 3 '文字色赤


●2回目処理　A1セル
【A】5【B】6【C】7
BBBBBBBBBBBBBBBBBBB
※B←黒色
Range("A1").Value = "【A】5"
Range("A1").Value = Range("A1").Value & "【B】6"
Range("A1").Characters(Start:=5, Length:=4).Font.ColorIndex = 3 '文字色赤
Range("A1").Value = Range("A1").Value & "【C】7"
Range("A1").Characters(Start:=9, Length:=4).Font.ColorIndex = 1 '文字色黒


1回目は問題なく黒赤と色が塗られます。
2回目の処理を行うと全部黒になってしまいます。

セル内の文字に黒赤黒赤と交互に文字色を塗ることはできないでしょうか。
お手数をおかけしますが考え方だけでもお教えいただけると幸いです。
よろしくお願いします。

No.6 ベストアンサー 回答者： GooUserラック 回答日時： 2016/09/09 12:07

シートモジュールの画像を添付しておきます。

参考にどうぞ！

No.5 回答者： tom04 回答日時： 2016/09/09 11:35

こんにちは！

横からお邪魔します。
A列限定にしています。
シートモジュールにしてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim k As Long
If Intersect(Target, Range("A:A")) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
.Font.ColorIndex = xlAutomatic
For k = 2 To Len(.Value) Step 2
.Characters(Start:=k, Length:=1).Font.ColorIndex = 3
Next k
End With
End Sub

こんな感じではではどうでしょうか？m(_ _)m

No.4 回答者： GooUserラック 回答日時： 2016/09/09 10:53

No.3 追加

数値として認識されているものは、このままではダメです。
数値も含めたいならば事前に文字列に変更する必要があります。

この回答へのお礼

早速の返事ありがとうございます。
すごく勉強になりますし助かります。
すいません。私自身がシートモジュールの「Worksheet_Change」イベントを今まで使ったことがないので勉強・確認させていただきますのでお礼に若干時間をください。
(本日夜返事予定です。)
お手数ですがよろしくお願いします。

お礼日時：2016/09/09 11:38

No.3 回答者： GooUserラック 回答日時： 2016/09/09 10:45

でしたら、以下をシートモジュールの「Worksheet_Change」イベントに記入してみてください。

--------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim 位置 As Long
For 位置 = 1 To Len(Target.Value)
If 位置 Mod 2 = 0 Then
Target.Characters(Start:=位置, Length:=1).Font.ColorIndex = 3
Else
Target.Characters(Start:=位置, Length:=1).Font.ColorIndex = 1
End If
Next
End Sub
--------------------------------------------------------------------------

No.2 回答者： GooUserラック 回答日時： 2016/09/09 10:10

No.1 追加

もちろんこれでも使えます。
--------------------------------------------------------------------------
Sub test()
Dim 位置 As Long
For 位置 = 1 To Len(Range("A1").Value)
If 位置 Mod 2 = 0 Then
Range("A1").Characters(Start:=位置, Length:=1).Font.ColorIndex = 3
Else
Range("A1").Characters(Start:=位置, Length:=1).Font.ColorIndex = 1
End If
Next
End Sub
--------------------------------------------------------------------------

この回答へのお礼

GooUserラックさん
早速の返事ありがとうございます。
2つとも事例ありがとうございます。両方試させていただきできるころを確認しました。
説明が足りず申し訳ありません
この方式ですと文字列がA1に全て入っている状態での色塗りの指定と思います。
できれば文字を追加して色塗り、文字を追加して色塗りと考えております。
この方法で交互の色付けは難しいのでしょうか。

お礼日時：2016/09/09 10:36

No.1 回答者： GooUserラック 回答日時： 2016/09/09 10:06

こんなのいかがですか？

--------------------------------------------------------------------------
Sub test()
Dim 位置 As Long
Range("A1").Select
For 位置 = 1 To Len(ActiveCell.Value)
If 位置 Mod 2 = 0 Then
ActiveCell.Characters(Start:=位置, Length:=1).Font.ColorIndex = 3
Else
ActiveCell.Characters(Start:=位置, Length:=1).Font.ColorIndex = 1
End If
Next
End Sub
--------------------------------------------------------------------------