盐城做网站优化,微信推广网站建设,北京建设住房和城乡建设官网,做推广自己找网站使用VBA代码修改单元格全部字符字体颜色是个很简单的任务#xff0c;例如设置A1单元格字体颜色为红色。
Range(A1).Font.Color RGB(255, 0, 0)有时需要修改部分字符的颜色#xff0c;如下图所示#xff0c;将红色字符字体颜色修改为蓝色。代码将会稍许复杂例如设置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 colorCall 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行代码恢复字符的删除线格式。
