修改Excel VBA函数 实现多指定文本统一字体颜色设置

原代码仅支持处理单个文本字符串，要实现同时对多个指定文本统一设置字体颜色，只需将单个搜索目标改为数组，并增加一层循环遍历每个关键词即可。以下是修改后的完整代码：

Sub SearchReplace_Color_PartialCell()
    ' 修改为支持多个搜索文本，统一设置字体颜色
    Dim textToChange As Variant
    textToChange = Array("cat", "dog", "raccoon") ' 在此添加所有需要处理的文本
    Const newColor = vbBlue
    Dim c As Range ' 当前处理的单元格
    Dim pos As Integer ' 搜索起始位置
    Dim matches As Integer ' 总匹配次数
    Dim keyword As Variant ' 遍历每个搜索关键词
    
    For Each c In ActiveSheet.UsedRange.Cells ' 遍历所有有数据的单元格
        For Each keyword In textToChange ' 遍历每个需要处理的关键词
            pos = 1
            Do While InStr(pos, c.Value, keyword) > 0 ' 循环查找当前单元格内的所有匹配项
                matches = matches + 1
                pos = InStr(pos, c.Value, keyword)
                ' 设置匹配文本的字体颜色
                c.Characters(pos, Len(keyword)).Font.Color = newColor
                pos = pos + 1 ' 偏移位置，避免重复匹配同一字符
            Loop
        Next keyword
    Next c

    MsgBox "共匹配并修改了 " & matches & " 处指定文本"
End Sub

关键改动说明 #

• 将原代码中单个常量textToChange改为数组，可在Array()中添加任意多个需要处理的文本字符串
• 新增For Each keyword In textToChange循环，遍历每个关键词执行颜色修改操作
• 调整消息提示内容，统计所有关键词的总匹配次数，适配多文本处理场景
• 简化Characters方法的参数调用，直接使用找到的pos位置，避免重复执行InStr查找

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