如何为TEXTJOIN拼接单元格中的重复指定单词设置不同字体颜色？

要处理文本中重复出现的目标单词着色，核心是通过循环+偏移起始位置的方式，反复调用InStr找到所有匹配项，直到找不到为止。以下是修正后的完整VBA代码，同时适配你示例里的Apples和Oranges两个单词：

Sub ColorSpecificWords()
    Dim targetCell As Range
    Dim cellText As String
    Dim findWord As String
    Dim startPos As Integer
    Dim wordLength As Integer
    
    ' 设置要处理的单元格（可按需修改，比如指定固定单元格范围）
    Set targetCell = ActiveCell
    cellText = targetCell.Value
    
    ' 处理"Apples"，设置为红色
    findWord = "Apples"
    wordLength = Len(findWord)
    startPos = InStr(1, cellText, findWord, vbTextCompare) ' vbTextCompare忽略大小写，可选
    
    Do While startPos > 0
        targetCell.Characters(startPos, wordLength).Font.Color = RGB(255, 0, 0)
        ' 更新起始位置，从当前匹配位置的下一个字符开始查找
        startPos = InStr(startPos + wordLength, cellText, findWord, vbTextCompare)
    Loop
    
    ' 处理"Oranges"，设置为橙色
    findWord = "Oranges"
    wordLength = Len(findWord)
    startPos = InStr(1, cellText, findWord, vbTextCompare)
    
    Do While startPos > 0
        targetCell.Characters(startPos, wordLength).Font.Color = RGB(255, 165, 0)
        startPos = InStr(startPos + wordLength, cellText, findWord, vbTextCompare)
    Loop
End Sub

关键细节说明 #

• 循环逻辑：每次找到匹配单词后，将下一次查找的起始位置设为当前匹配位置 + 单词长度，既避免重复着色同一单词，又能覆盖所有后续出现的目标内容。
• 灵活适配：用Len(findWord)自动获取单词长度，替代原代码硬编码的5，避免因单词拼写变化导致的错误；如果需要严格区分大小写，去掉vbTextCompare参数即可。
• 扩展性：若要添加更多单词着色，直接复制对应的处理块，修改findWord和颜色RGB值即可。

使用步骤 #

1. 选中需要处理的目标单元格；
2. 按Alt+F11打开VBA编辑器；
3. 插入新模块，粘贴上述代码；
4. 运行ColorSpecificWords宏即可完成着色。

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