使用VBA代码修改单元格全部字符字体颜色是个很简单的任务，例如设置A1单元格字体颜色为红色。
Range("A1").Font.Color = RGB(255, 0, 0)
有时需要修改部分字符的颜色，如下图所示，将红色字符字体颜色修改为蓝色。代码将会稍许复杂，需要使用Characters设置逐个字符的字体颜色。
先使用代码来读取单元格的字体颜色。
Sub CheckFontColor()
Dim c As Range, i As Long
Set c = Range("A1")
For i = 1 To Len(c.Value)
With c.Characters(i, 1).Font
Debug.Print i, .Color
End With
Next
End Sub
输出如下所示，前5个字符和最后两个字符为红色。
1 255
2 255
3 255
4 255
5 255
6 0
7 0
8 255
9 255
略加修改，逐个字符判断字体颜色，修改红色字符为蓝色。
Sub ChangeColor1()
Dim c As Range, i As Long, ColS As Long, ColE As Long
Range("A1").Copy Range("A2")
ColS = RGB(255, 0, 0)
ColE = RGB(0, 0, 255)
Set c = Range("A2")
For i = 1 To Len(c.Value)
With c.Characters(i, 1).Font
If .Color = ColS Then
.Color = ColE
End If
End With
Next
End Sub
运行代码过程ChangeColor1，结果和想象的并不相同，如下所示。前5个字符的删除线消失了，最后两个字符的颜色仍然是红色。
为什么会出现这个奇怪的结果呢？增加部分代码来看一下执行过程。
Sub ChangeColor2()
Dim c As Range, i As Long, ColS As Long, ColE As Long
Range("A1").Copy Range("A2")
ColS = RGB(255, 0, 0)
ColE = RGB(0, 0, 255)
Set c = Range("A2")
Debug.Print "before change color"
Call CheckColor
For i = 1 To Len(c.Value)
With c.Characters(i, 1).Font
If .Color = ColS Then
.Color = ColE
End If
End With
Debug.Print i
Call CheckColor
Next
End Sub
Sub CheckColor()
Debug.Print Range("A1").Characters(11, 1).Font.Color, Range("A2").Characters(11, 1).Font.Color
Debug.Print Range("A1").Characters(12, 1).Font.Color, Range("A2").Characters(12, 1).Font.Color
End Sub
部分输出结果如下：
before change color
255 255
255 255
1
255 16711680
255 16711680
2
255 16711680
255 16711680
3
255 16711680
255 16711680
执行For循环之前，A1和A2单元格内容完全相同，最后两个字符的颜色均为红色，然而执行循环第一次之后，也就是第一个字符修改为蓝色，此时最后两个字符的颜色被修改为了16711680（即RGB(0,0,255)），但是此时单元格中的最后两个字符仍然显示为红色，这个应该是Excel的BUG.
执行循环第一次之后，第一个字符有删除线格式，后面几个字符的删除线已经消失，执行第二次循环之后，第二字符字体颜色被修改为蓝色，但是第一个字符的删除线格式消失了。由于最后两个字符的Font.Color的返回值不再是255，因此后续代码不会更新那两个字符的字体颜色，最终仍然为红色字符。
VBA处理这种复合字体格式（单元格中的字符具备多种不同的字体格式）会出现这种诡异的现象，但是也是有变通方法可以实现这个需求的。
Type FontStyle
Color As Long
Strikethrough As Boolean
End Type
Sub ChangeColor3()
Dim c As Range, i As Long, ColS As Long, ColE As Long
Dim CellFont() As FontStyle
ColS = RGB(255, 0, 0)
ColE = RGB(0, 0, 255)
Range("A1").Copy Range("A2")
Set c = Range("A2")
ReDim CellFont(1 To Len(c.Value))
For i = 1 To Len(c.Value)
With c.Characters(i, 1).Font
CellFont(i).Color = .Color
CellFont(i).Strikethrough = .Strikethrough
End With
Next
For i = 1 To Len(c.Value)
With c.Characters(i, 1).Font
If CellFont(i).Color = ColS Then
.Color = ColE
Else
.Color = CellFont(i).Color
End If
.Strikethrough = CellFont(i).Strikethrough
End With
Next
End Sub
【代码解析】
第1~4行代码声明自定义数据结构。
第13~18行代码将每个字符的字体属性保存在数组CellFont中。
第19~28行代码循环遍历每个字符。
第21行代码判断字符颜色，如果颜色匹配，第22行代码更新字符的字体颜色，否则第24行代码恢复字符的原字体颜色。
此处使用CellFont(i).Color，避免更新字符字体格式对于其他字符格式的影响。
第26行代码恢复字符的删除线格式。
