image.png
要求：提取Word中每个《》之间的文本。(代码在Excel中）
代码1：查找替换
Sub 提取特定字符中间的内容() '查找替换
Dim wdapp As Object, wdoc As Object '声明wdapp和wdoc变量为对象类型
Set wdapp = CreateObject("Word.Application") '将新建word程序对象赋给变量wdapp
Dim Findchar As String '要查找的字符
Findchar = "《*》"
Set wdoc = wdapp.Documents.Open(ThisWorkbook.Path & "\范例.docx") '打开word文档
With wdoc.Content.Find '此处针对全文档
.MatchWildcards = True '使用通配符
Do While .Execute(FindText:=Findchar) = True '将内容返回到Excel
k = k + 1
Cells(k, 1) = .Parent '此代码没有处理符号
Cells(k, 2) = Replace(Replace(.Parent, "《", ""), "》", "") '此代码去除符号
Loop
End With
wdoc.Close False '关闭word文档，不保存更改。
wdapp.Quit '关闭word程序
Set wdapp = Nothing '释放内存
Set wdoc = Nothing '释放内存
End Sub
代码2：Split方法
Sub 提取特定字符中间的内容1() 'split
Dim wdapp As Object, wdoc As Object '声明wdapp和wdoc变量为对象类型
Set wdapp = CreateObject("Word.Application") '将新建word程序对象赋给变量wdapp
Dim schar As String '字符串
Set wdoc = wdapp.Documents.Open(ThisWorkbook.Path & "\范例.docx") '打开word文档
schar = wdoc.Content '将文档内容赋值给字符串
wdoc.Close False '关闭word文档，不保存更改。
wdapp.Quit '关闭word程序
Set wdapp = Nothing '释放内存
Set wdoc = Nothing '释放内存
Dim s
s = Split(schar, "《")
For Each s1 In s
If InStr(s1, "》") > 0 Then
k = k + 1
Cells(k, 1) = Split(s1, "》")(0)
End If
Next
End Sub
代码3：正则表达式,三个表达式都能够实现结果，注意submatchse就行。
Sub 提取特定字符中间的内容2() '正则
Dim wdapp As Object, wdoc As Object '声明wdapp和wdoc变量为对象类型
Set wdapp = CreateObject("Word.Application") '将新建word程序对象赋给变量wdapp
Dim schar As String '字符串
Set wdoc = wdapp.Documents.Open(ThisWorkbook.Path & "\范例.docx") '打开word文档
schar = wdoc.Content '将文档内容赋值给字符串
wdoc.Close False '关闭word文档，不保存更改。
wdapp.Quit '关闭word程序
Set wdapp = Nothing '释放内存
Set wdoc = Nothing '释放内存
With CreateObject("vbscript.regexp")
.Global = True
' .Pattern = "《([^》]+)》"
' .Pattern = "《(.*?)》"
.Pattern = "[^《]+(?=》)"
Set matc = .Execute(schar)
For Each mat In matc
k = k + 1
' Cells(k, 1) = mat.submatchse(0)
Cells(k, 1) = mat.Value
Next
End With
End Sub
结果：
image.png
