使用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行代码恢复字符的删除线格式。