苏州网络自学网站建设深圳建设交易平台官网
使用VBA代码修改单元格全部字符字体颜色是个很简单的任务，例如设置A1单元格字体颜色为红色。
Range("A1").Font.Color = RGB(255, 0, 0)
有时需要修改部分字符的颜色，如下图所示，将红色字符字体颜色修改为蓝色。代码将会稍许复杂，需要使用Characters设置逐个字符的字体颜色。
先使用代码来读取单元格的字体颜色。
Sub CheckFontColor()Dim c As Range, i As LongSet c = Range("A1")For i = 1 To Len(c.Value)With c.Characters(i, 1).FontDebug.Print i, .ColorEnd WithNext
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 LongRange("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).FontIf .Color = ColS Then.Color = ColEEnd IfEnd WithNext
End Sub
运行代码过程ChangeColor1，结果和想象的并不相同，如下所示。前5个字符的删除线消失了，最后两个字符的颜色仍然是红色。
为什么会出现这个奇怪的结果呢？增加部分代码来看一下执行过程。
Sub ChangeColor2()Dim c As Range, i As Long, ColS As Long, ColE As LongRange("A1").Copy Range("A2")ColS = RGB(255, 0, 0)ColE = RGB(0, 0, 255)Set c = Range("A2")Debug.Print "before change color"Call CheckColorFor i = 1 To Len(c.Value)With c.Characters(i, 1).FontIf .Color = ColS Then.Color = ColEEnd IfEnd WithDebug.Print iCall CheckColorNext
End SubSub CheckColor()Debug.Print Range("A1").Characters(11, 1).Font.Color, Range("A2").Characters(11, 1).Font.ColorDebug.Print Range("A1").Characters(12, 1).Font.Color, Range("A2").Characters(12, 1).Font.Color
End Sub
部分输出结果如下：
before change color255 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 FontStyleColor As LongStrikethrough As Boolean
End Type
Sub ChangeColor3()Dim c As Range, i As Long, ColS As Long, ColE As LongDim CellFont() As FontStyleColS = 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).FontCellFont(i).Color = .ColorCellFont(i).Strikethrough = .StrikethroughEnd WithNextFor i = 1 To Len(c.Value)With c.Characters(i, 1).FontIf CellFont(i).Color = ColS Then.Color = ColEElse.Color = CellFont(i).ColorEnd If.Strikethrough = CellFont(i).StrikethroughEnd WithNext
End Sub
【代码解析】
第1~4行代码声明自定义数据结构。
第13~18行代码将每个字符的字体属性保存在数组CellFont中。
第19~28行代码循环遍历每个字符。
第21行代码判断字符颜色，如果颜色匹配，第22行代码更新字符的字体颜色，否则第24行代码恢复字符的原字体颜色。
此处使用CellFont(i).Color，避免更新字符字体格式对于其他字符格式的影响。
第26行代码恢复字符的删除线格式。