Excel宏实现单元格添加带颜色条目并保留历史格式

问题核心在于直接修改单元格Value会重置所有字符格式，导致之前设置的颜色丢失。要保留原有格式，需通过Characters.Append相关方法追加内容，而非直接覆盖单元格值。

修改后的代码（绿色条目示例） #

Sub addTextAtEndCellGreen()
    Dim myValue As Variant
    Dim newText As String
    Dim startPos As Integer
    
    myValue = InputBox("Give me some input")
    ' 取消输入时直接退出
    If myValue = "" Then Exit Sub
    
    newText = Date & " - " & myValue
    
    With ActiveCell
        ' 单元格为空时直接添加内容
        If .Value = "" Then
            .Value = newText
            .Characters.Font.Color = vbGreen
        Else
            ' 先追加换行符，再添加新内容
            startPos = .Characters.Count + 1
            .Characters(startPos).Text = vbNewLine & newText
            ' 为新增的内容设置颜色（从换行后的位置开始）
            .Characters(startPos + 1).Font.Color = vbGreen
        End If
    End With
End Sub

关键改进点 #

• 避免直接赋值ActiveCell.Value，改用Characters.Text追加内容，完整保留原有字符格式
• 新增取消输入的判断逻辑，避免插入空内容
• 精准定位新增内容的起始位置，仅对新添加的文本设置颜色

扩展到其他条目类型（如离岗备注红色） #

只需复制上述代码，修改颜色常量和宏名称即可：

Sub addTextAtEndCellRed()
    Dim myValue As Variant
    Dim newText As String
    Dim startPos As Integer
    
    myValue = InputBox("输入离岗备注")
    If myValue = "" Then Exit Sub
    
    newText = Date & " - " & myValue
    
    With ActiveCell
        If .Value = "" Then
            .Value = newText
            .Characters.Font.Color = vbRed
        Else
            startPos = .Characters.Count + 1
            .Characters(startPos).Text = vbNewLine & newText
            .Characters(startPos + 1).Font.Color = vbRed
        End If
    End With
End Sub

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