如何用VBA为含公式的Excel单元格中部分文本修改颜色？

需要对包含公式的Excel单元格计算结果中的指定文本设置颜色，例如将单元格公式结果里的"cooler"和"slightly decreasing"改为蓝色。现有VBA代码仅能处理纯文本单元格，无法识别公式计算出的显示文本，需对代码进行修改。

修改后的VBA代码 #

Sub HighlightKeywordsDynamically()
    Dim rngCell As Range
    Dim displayText As String
    Dim keywordPos As Long
    Dim keyword As String
    Dim i As Integer

    ' 设置目标单元格范围
    Set rngCell = Range("B392:B412")

    ' 蓝色关键词数组
    Dim blueKeywords As Variant
    blueKeywords = Array("slightly decreasing", "significantly decreasing", "sharply decreasing", "below average", "coldest place", "coldest night", "coldest day", "smallest diurnal", "cooler")

    ' 红色关键词数组
    Dim redKeywords As Variant
    redKeywords = Array("slightly increasing", "significantly increasing", "sharply increasing", "above average", "hottest place", "hottest night", "hottest day", "largest diurnal", "warmer")

    ' 遍历每个单元格
    For Each cell In rngCell
        ' 获取公式计算后的显示文本
        displayText = cell.Value
        ' 重置单元格字体为默认颜色，避免重复叠加
        cell.Font.ColorIndex = xlAutomatic

        ' 处理蓝色关键词
        For i = LBound(blueKeywords) To UBound(blueKeywords)
            keyword = blueKeywords(i)
            keywordPos = InStr(1, displayText, keyword, vbTextCompare)
            If keywordPos > 0 Then
                If keyword = "cooler" Then
                    ' 包含前面的温度数值部分（如-0.86 °C）
                    cell.Characters(Start:=keywordPos - 9, Length:=Len(keyword) + 9).Font.Color = RGB(0, 0, 255)
                Else
                    cell.Characters(Start:=keywordPos, Length:=Len(keyword)).Font.Color = RGB(0, 0, 255)
                End If
            End If
        Next i

        ' 处理红色关键词
        For i = LBound(redKeywords) To UBound(redKeywords)
            keyword = redKeywords(i)
            keywordPos = InStr(1, displayText, keyword, vbTextCompare)
            If keywordPos > 0 Then
                If keyword = "warmer" Then
                    ' 包含前面的温度数值部分
                    cell.Characters(Start:=keywordPos - 9, Length:=Len(keyword) + 9).Font.Color = RGB(255, 0, 0)
                Else
                    cell.Characters(Start:=keywordPos, Length:=Len(keyword)).Font.Color = RGB(255, 0, 0)
                End If
            End If
        Next i
    Next cell
End Sub

关键修改点 #

• 获取正确文本：将原代码的cell.Formula改为cell.Value，获取公式计算后的显示内容，而非单元格内的公式代码。
• 重置默认颜色：新增cell.Font.ColorIndex = xlAutomatic，每次处理前清空已有颜色设置，防止多次运行后颜色混乱。
• 匹配逻辑调整：所有关键词的位置查找基于显示文本，确保准确定位到计算结果中的目标词汇。

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