英文:
How to extract sentences containing any of several words using Word VBA
问题
我有一个Microsoft Word文件，名为Tst.doc，其中包含以下句子：
沙发1。
沙发2。
椅子1。
椅子2。
座位1。
座位2。
我需要提取所有包含以下任意单词（沙发、椅子、座位）的句子到一个名为OutputBin.doc的第二个文件中，该文件存储在固定位置。
我根据一个现有模块编写了以下代码，该模块只能处理一个单词，但我的代码工作不稳定：三个单词的相对位置很重要，所以我认为我无法重置单词查找范围（每次搜索后它都在不断缩小？）
```vba
Sub Extract_MANY_OR()
Dim liste As String
Dim file1 As String
Dim file2 As String: file2 = "D:\OutputBin.doc"
'每次都要更改这个！
file1 = "D:\TST.doc"
liste = "座位,沙发,椅子"
Dim i As Integer
'为文档分配变量
Dim wrdDoc1 As Document: Set wrdDoc1 = Documents.Open(file1)
Dim wrdDoc2 As Document: Set wrdDoc2 = Documents.Open(file2)
Dim r1 As Range: Set r1 = wrdDoc1.Range
Dim r2 As Range: Set r2 = wrdDoc2.Range
For i = 0 To UBound(Split(liste, ","))
With r1
.Find.Text = Split(liste, ",")(i)
.Find.MatchCase = False '
' .Find.MatchCase = True
Do While .Find.Execute
r1.Expand Unit:=wdSentence
wrdDoc2.Characters.Last.FormattedText = r1.FormattedText
r2.InsertParagraphAfter
r1.Collapse wdCollapseEnd
Loop
End With
Next i
End Sub
英文:
I have a Microsoft Word file, Tst.doc that contains the following sentences:
Sofa 1.
Sofa 2.
Chair 1.
Chair 2.
Seat 1.
Seat 2.
I need to extract all the sentences containing any of the words (sofa,chair,seat) to a second file named OutputBin.doc that is stored in a fixed location.
I wrote the following code, based on an existing module that is able to work only on one word, and my code is only working erratically: the relative position of the three words matters, so I believe I am not able to reset the word find range (it is shrinking continuously after each search?)
Sub Extract_MANY_OR()
Dim liste As String
Dim file1 As String
Dim file2 As String: file2 = "D:\OutputBin.doc"
' Change this every time!
file1 = "D:\TST.doc"
liste = "seat,sofa,chair"
Dim i As Integer
' assign variables for the documents
Dim wrdDoc1 As Document: Set wrdDoc1 = Documents.Open(file1)
Dim wrdDoc2 As Document: Set wrdDoc2 = Documents.Open(file2)
Dim r1 As Range: Set r1 = wrdDoc1.Range
Dim r2 As Range: Set r2 = wrdDoc2.Range
For i = 0 To UBound(Split(liste, ","))
With r1
.Find.Text = Split(liste, ",")(i)
.Find.MatchCase = False '
' .Find.MatchCase = True
Do While .Find.Execute
r1.Expand Unit:=wdSentence
wrdDoc2.Characters.Last.FormattedText = r1.FormattedText
r2.InsertParagraphAfter
r1.Collapse wdCollapseEnd
Loop
End With
Next i
End Sub
答案1
得分: 1
你需要在每个单词之后重置搜索范围。
英文:
You need to reset the search range after each word.
Sub Extract_MANY_OR()
Dim liste As String
Dim file1 As String
Dim file2 As String: file2 = "D:\OutputBin.doc"
' Change this every time!
file1 = "D:\TST.doc"
liste = "seat,sofa,chair"
Dim i As Integer
' assign variables for the documents
Dim wrdDoc1 As Document: Set wrdDoc1 = Documents.Open(file1)
Dim wrdDoc2 As Document: Set wrdDoc2 = Documents.Open(file2)
For i = 0 To UBound(Split(liste, ","))
' Reset the range after each word
Dim r1 As Range: Set r1 = wrdDoc1.Range
Dim r2 As Range: Set r2 = wrdDoc2.Range
With r1
.Find.Text = Split(liste, ",")(i)
.Find.MatchCase = False '
' .Find.MatchCase = True
Do While .Find.Execute
r1.Expand Unit:=wdSentence
wrdDoc2.Characters.Last.FormattedText = r1.FormattedText
r2.InsertParagraphAfter
r1.Collapse wdCollapseEnd
Loop
End With
Next i
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论