Bootstrap

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

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

;