正则表达式还是很有用的，哈哈，看代码
Option Base 1
Sub test()
Dim xl As Object, wb As Object, sht As Object
"定义正则表达式对象
Dim reg As Object
"定义匹配字符串集合对象
Dim objMatches As Object
"定义匹配字符串对象
Dim objMatch As Object
Dim strArr()
Set doc = ActiveDocument
"创建正则表达式
Set reg = CreateObject("vbscript.regexp")
"定义要执行正则查找的文本变量
Dim sText As String
"sText = "综上所述，石角岭山塘大坝安全类别初步评定为 二类坝。"
sText = doc.Content
With reg
"设置是否匹配所有的符合项，True表示匹配所有, False表示仅匹配第一个符合项
.Global = True
"设置是否区分大小写，True表示不区分大小写, False表示区分大小写
.IgnoreCase = True
"设置要查找的字符模式
.Pattern = "(\s|[\u4e00-\u9fa5])*类坝"
"判断是否可以找到匹配的字符，若可以则返回True
"MsgBox .test(sText)
"对字符串执行正则查找，返回所有的查找值的集合，若未找到，则为空
Set objMatches = .Execute(sText)
ReDim strArr(1 To objMatches.Count, 3)
With objMatches
For k = 0 To .Count - 1
strArr(k + 1, 1) = .Item(k).Value
Next k
End With
"把字符串中用正则找到的所有匹配字符替换为其它字符
"MsgBox .Replace(sText, "")
End With
Set objReg = Nothing
Set objMatches = Nothing
Set xl = CreateObject("excel.application"): xl.Visible = True
Set wb = xl.workbooks.Add
Set sht = wb.worksheets(1)
sht.Range("a1").Resize(UBound(strArr), UBound(strArr, 2)).Value = strArr
MsgBox "数据已经读取完成"
End Sub
