如何用Excel VBA根据多行单元格行颜色追加文本？

问题背景 #

Excel工作表中存有多年积累的大量数据，部分单元格是单行内容，部分是多行（每行对应一条记录，用换行分隔），其中D至M列共10列数据格式一致。红色字体的行代表已离职用户，需要给这类行追加特定文本*term——因为Power Query无法保留单元格格式，后续要通过这个标记在Power Query中创建状态列。

最初找到的示例代码无法实现仅筛选红色行的逻辑，修改后完成了批量处理选中区域的需求。

参考示例代码（无法识别颜色） #

这段代码仅能给单元格内所有行追加文本，无法区分颜色：

Public Sub RePrint()

Dim MyRange As Range
Dim MyArray As Variant
Dim i As Long

Set MyRange = Range("A1")
MyArray = Split(MyRange, Chr(10))
For i = LBound(MyArray) To UBound(MyArray)
    MyArray(i) = MyArray(i) & " Text" & i
Next i

MyRange = Join(MyArray, Chr(10))

End Sub

最终解决代码 #

以下代码可批量处理选中区域，仅给红色字体的行追加*term：

Sub Append()

Dim MyRange As Range
Dim selectedRange As Range
Dim MyArray As Variant
Dim i As Long
Dim myChars As Long
Dim myColorindex As Variant

Set selectedRange = Application.Selection

For Each MyRange In selectedRange.Cells
myChars = 1
MyArray = Split(MyRange, Chr(10))
For i = LBound(MyArray) To UBound(MyArray)
    myColorindex = MyRange.Characters(myChars, 1).Font.ColorIndex
    myChars = myChars + Len(MyArray(i)) + 1
    If myColorindex = 3 Then
        MyArray(i) = MyArray(i) & "*term"
    Else
        MyArray(i) = MyArray(i)
    End If
Next i
MyRange = Join(MyArray, Chr(10))
Next MyRange

End Sub

关键逻辑说明 #

• 以用户选中的区域为处理范围，遍历每个单元格
• 用Chr(10)拆分单元格内容为数组，对应每行记录
• 通过myChars变量跟踪每行内容的起始字符位置，获取该行首字符的字体颜色索引（红色对应ColorIndex=3）
• 仅对红色字体的行追加*term标记，其他行保持原样
• 最后将数组重新合并为带换行的单元格内容

内容的提问来源于stack exchange，提问作者Jerod4444