单个word正则匹配成功案例，互联网的美好就在于共享，所以我也共享之

Sub Macro2()

Dim mRegExp As Object Set mRegExp = CreateObject("vbscript.regexp") Dim myRange As String myRange = ActiveDocument.Content.Text Dim oMatches As Variant Dim n As Variant Dim zifu As String Dim rongqi As Object Set rongqi = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") zifu = "罗江生态环境局" rongqi.settext zifu rongqi.putinclipboard Dim oRng As Range Dim changdu As Variant Dim pos1, pos2, pos3 As Variant Dim duolai As Variant pos3 = 1 duolai = 0 With mRegExp .Global = True .Pattern = "生态环境局|区生态环境局" Set oMatches = .Execute(myRange) For Each m In oMatches myRange = ActiveDocument.Content.Text changdu = m.Length pos1 = InStr(pos3 + duolai, myRange, m) - 1 pos3 = pos1 + changdu pos2 = pos1 + changdu Set oRng = ActiveDocument.Range(Start:=pos1, End:=pos2) oRng.Select n = MsgBox("要替换吗？## 标题", 1) If n = 1 Then Selection.Paste If changdu = 5 Then duolai = 2 ElseIf changdu = 6 Then duolai = 1 End If Else End If Next End With

End Sub