奇怪的Excel单元格字体颜色格式

使用VBA代码修改单元格全部字符字体颜色是个很简单的任务，例如设置A1单元格字体颜色为红色。

vb 复制代码

Range("A1").Font.Color = RGB(255, 0, 0)

有时需要修改部分字符的颜色，如下图所示，将红色字符字体颜色修改为蓝色。代码将会稍许复杂，需要使用Characters设置逐个字符的字体颜色。

先使用代码来读取单元格的字体颜色。

vb 复制代码

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

略加修改，逐个字符判断字体颜色，修改红色字符为蓝色。

vb 复制代码

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个字符的删除线消失了，最后两个字符的颜色仍然是红色。

为什么会出现这个奇怪的结果呢？增加部分代码来看一下执行过程。

vb 复制代码

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

部分输出结果如下：

vb 复制代码

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处理这种复合字体格式（单元格中的字符具备多种不同的字体格式）会出现这种诡异的现象，但是也是有变通方法可以实现这个需求的。

vb 复制代码

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