Word VBA代码修改需求：仅对绿松石色高亮文本执行Redact操作

我帮你调整了代码，现在可以精准识别**绿松石色（或你指定的颜色）**的高亮文本，只对这类带单下划线的内容执行红act操作，其他颜色高亮的内容会保持原样。

修改后的完整代码 #

Sub RedactSpecificHighlight()
' RedactSpecificHighlight 宏
' 仅对带绿松石色高亮+单下划线的文本执行Redact操作
' 执行后替换为“x”，字体黑色，黑色高亮
    Dim OldText, OldLastChar, NewLastChar, NewText, ReplaceChar As String
    Dim flag As Boolean
    Const TargetHighlightColor As Integer = wdTurquoise ' 指定目标高亮颜色，可修改为其他wd常量或自定义值
    
    Application.ScreenUpdating = False
    ReplaceChar = "x"
    flag = True
    
    While flag = True
        ' 重置查找格式
        Selection.Find.ClearFormatting
        ' 设置查找条件：单下划线 + 指定颜色的高亮
        Selection.Find.Font.Underline = wdUnderlineSingle
        Selection.Find.HighlightColorIndex = TargetHighlightColor
        
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = ""
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindAsk
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        
        ' 执行查找，没找到则终止循环
        If Not Selection.Find.Execute Then
            flag = False
            Exit While
        End If
        
        ' 双重验证：确保找到的内容符合下划线+指定高亮的条件
        If Selection.Font.Underline <> wdUnderlineSingle Or _
           Selection.Range.HighlightColorIndex <> TargetHighlightColor Then
            Continue While ' 不符合则跳过，继续查找下一个
        End If
        
        ' 创建替换字符串：保留末尾的回车符
        OldText = Selection.Text
        OldLastChar = Right(OldText, 1)
        NewLastChar = ReplaceChar
        ' 精准判断回车符（Unicode 13）
        If Asc(OldLastChar) = 13 Then
            NewLastChar = OldLastChar
        End If
        NewText = String(Len(OldText) - 1, ReplaceChar) & NewLastChar
        
        ' 执行红act操作
        Selection.Text = NewText
        Selection.Font.ColorIndex = wdBlack
        Selection.Font.Underline = False
        Selection.Range.HighlightColorIndex = wdBlack
    Wend
    
    Application.ScreenUpdating = True
    MsgBox "指定颜色的红act操作完成！", vbInformation
End Sub

关键修改说明 #

• 指定目标高亮颜色：新增了Const TargetHighlightColor As Integer = wdTurquoise，你可以直接修改这个常量值来指定其他颜色，比如wdYellow（黄色）、wdBlue（蓝色）。
• 精准查找条件：把原代码中仅判断Highlight = True改成直接指定HighlightColorIndex，确保只锁定目标颜色的高亮文本。
• 修复语法错误：移除了原代码中多余的End If，避免运行时触发语法报错。
• 双重验证机制：查找后额外验证内容的下划线和高亮颜色，防止因格式匹配偏差导致误操作。
• 优化回车符判断：用Asc(OldLastChar) = 13更精准识别回车符，修正了原代码中Like "[?*#]"的逻辑错误。

自定义颜色提示 #

如果你需要使用自定义的RGB颜色（比如特定色调的绿松石色），可以先获取该颜色的ColorIndex：

' 临时运行这段代码获取目标颜色的索引
Sub GetHighlightColorIndex()
    MsgBox Selection.Range.HighlightColorIndex
End Sub

选中带目标颜色高亮的文本，运行上面的宏，即可得到对应的ColorIndex值，替换到TargetHighlightColor中即可。

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