如何在word中查找替换某个字符但是保留指定的词语？

比如在某个word文档中想要查找删除所有“应”字，但是要保留词组“效应、应急、应运、反应”中的“应”字。

用word的查找替换无法实现，结合正则表达式遍历每一个查找到的结果进行判断才能实现。

以下是实现代码：

Sub QQ1722187970()
    Dim oDoc As Document
    Set oDoc = Word.ActiveDocument
    Dim oRng As Range
    Set oRng = Word.Selection.Range
    iStart = oRng.Start
    '先判断是否有选中区域，没有选中则表示整个文档
    If oRng.Start = oRng.End Then
        Set oRng = oDoc.Content
        iStart = 0
    End If
    sText = oRng.Text
    arr = Array("响应", "反应", "应急", "应运", "应")
    For i = 0 To UBound(arr)
    arr(i) = arr(i)
    Next i
    sFtext = Join(arr, "|")
    Dim oRng1 As Range
    Dim oRegExp As Object
    '定义匹配字符串集合对象
    Dim oMatches As Object
    '定义匹配子字符串集合对象
    Dim oSubMatches As Object
    '创建正则表达式
    Set oRegExp = CreateObject("vbscript.regexp")
    With oRegExp
    '设置是否匹配所有的符合项，True表示匹配所有, False表示仅匹配第一个符合项
    .Global = True
    '设置是否区分大小写，True表示不区分大小写, False表示区分大小写
    .IgnoreCase = True
    '设置要查找的正则规则
    .Pattern = sFtext
    '判断是否可以找到匹配的字符，若可以则返回True
    If .Test(sText) Then
    '对字符串执行正则查找，返回所有的查找值的集合，若未找到，则为空
    Set oMatches = .Execute(sText)
    For i = oMatches.Count - 1 To 0 Step -1
        Set obj = oMatches(i)
        If Len(obj.Value) = 1 Then
            Set oRng1 = oDoc.Range(obj.firstindex + iStart, obj.firstindex + iStart + 1)
            oRng1.Text = ""
        End If
    Next
    End If
    End With
    Set oRegExp = Nothing
    Set oMatches = Nothing
End Sub

以上代码仅对于word文档是纯文本内容时有效，如果含有表格、图片等对象时，会导致用正则获得的字符串结果的位置出现偏差，从而导致替换错误。

为了避免以上问题，可以利用正则查找字符串，然后再调用word的查找替换功能进行查找替换，以下是一个示例代码：

Sub QQ1722187970()
    Dim oDoc As Document
    Set oDoc = Word.ActiveDocument
    Dim oRng As Range
    Set oRng = Word.Selection.Range
    iStart = oRng.Start
    Dim sText As String
    '先判断是否有选中区域，没有选中则表示整个文档
    If oRng.Start = oRng.End Then
        Set oRng = oDoc.Content
        iStart = 0
    End If
    sText = oRng.Text
    sFtext = "(([0-9]+\,)*([0-9]+\,)*([0-9]+\,)*([0-9]+\,)*[0-9]+((\.[0-9]+)*))元"
    '    sFtext = "元"
    Dim oRng1 As Range
    Dim oRegExp As Object
    '定义匹配字符串集合对象
    Dim oMatches As Object
    '定义匹配子字符串集合对象
    Dim oSubMatches As Object
    '创建正则表达式
    Set oRegExp = CreateObject("vbscript.regexp")
    With oRegExp
        '设置是否匹配所有的符合项，True表示匹配所有, False表示仅匹配第一个符合项
        .Global = True
        .MultiLine = True
        '设置是否区分大小写，True表示不区分大小写, False表示区分大小写
        .IgnoreCase = True
        '设置要查找的正则规则
        .Pattern = sFtext
        '判断是否可以找到匹配的字符，若可以则返回True
        If .test(sText) Then
            '对字符串执行正则查找，返回所有的查找值的集合，若未找到，则为空
            Set oMatches = .Execute(sText)
            For i = oMatches.Count - 1 To 0 Step -1
                Set oFind = oMatches(i)
                With oFind
                    '找到的结果的位置
                    iPos = .firstindex
                    '找到的结果字符串的长度
                    iLen = .Length
                    '找到的结果的子集
                    sText = .submatches(0)
                    '找到的结果
                    sFind = .Value
                End With
                sReplace = Format(sText / 10000, "###,###,###,##0.00") & "万元"
                Call FindAndReplace(sFind, sReplace)
            Next
        End If
    End With
    Set oRegExp = Nothing
    Set oMatches = Nothing
End Sub
Sub FindAndReplace(ByVal sFind As String, ByVal sReplace As String)
    Const wdReplaceAll = 2
    Dim oRng As Range
    Set oRng = ActiveDocument.Content
    With oRng.Find
        .Execute FindText:=sFind, ReplaceWith:=sReplace, _
        Replace:=wdReplaceAll
    End With
End Sub