excel - VBA 在 Word Doc 中选择范围,然后在 Excel 中粘贴范围
问题描述
我有多个文档,其中包含不同方法的设备和程序列表。我想要一个可以执行以下操作的代码:
第一:在 Word Doc 中找到给定的方法编号
第二:查看方法编号以确定哪个先出现,“设备-”或“程序和评估-”。“设备-”,如果出现总是在“程序和评估-”之前,但如果“程序和评估-”在前,那么“设备-”将不会出现。
第三:复制“设备-”和“程序和评估-”之间的文本范围(如果存在“设备-”)并粘贴到Excel
第四步:复制“Procedure and Evaluation -”和“Design”之间的文本范围,粘贴到Excel中。(“设计”是表示方法编号结束的词)
不幸的是,我不擅长在 Excel 和 Word 之间切换,而且我知道下面的代码有很多问题。“rng.Find”的使用似乎不允许我使用它的方式,以及我确定的其他多种事情。任何帮助我指出能够定位文档中哪个单词最先出现的方向,以及能够根据特定单词将一系列文本传输到 Excel,将不胜感激。
Sub Find_and_Copy()
Dim oWord As Word.Application
Dim oWdoc As Word.Document
Dim LastRow As Integer
Dim i As Integer
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim Text1 As String
Dim Text2 As String
Set oWord = Word.Application
Set oWdoc = oWord.Documents.Open("C:\Test.docx")
Set rng = oWdoc.Range
LastRow = Sheets("Temp").Cells.SpecialCells(xlCellTypeLastCell).Row
'Loop through rows searching for the Method Number, Equipment, Procedure, & Design
'Start on Row 4
For i = 4 To LastRow
'Check to make sure cell is not blank, if it is, then go to next iteration
If Sheets("Temp").Cells(i, 6).Value = "" Then
GoTo NextIteration
End If
'Set the Method Number to find
strFnd = Sheets("Temp").Cells(i, 6).Value & "."
'Locate the Method Number and transfer the text between (but not including) "Equipment -" & "Procedure and Evaluation -" and "Procedure and Evaluation -" & "Design" if they both appear.
'I don't know how to check if Equipment - comes before "Procedure and Evaluation"
If rng.Find.Execute(FindText:=strFnd) Then
Set rng1 = oWdoc.Range(rng.End, oWdoc.Range.End)
If rng1.Find.Execute(FindText:="Equipment -") Then
Set rng2 = oWdoc.Range(rng1.End, oWdoc.Range.End)
If rng2.Find.Execute(FindText:="Procedure and Evaluation -") Then
Text1 = oWdoc.Range(rng1.End, rng2.Start).text
Set rng3 = oWdoc.Range(rng2.End, oWdoc.Range.End)
If rng3.Find.Execute(FindText:="Design") Then
Text2 = oWdoc.Range(rng2.End, rng3.Start).text
Else
Text2 = ""
End If
ElseIf rng2.Find.Execute(FindText:="Desing") Then
Text1 = oWdoc.Range(rng1.End, rng2.Start).text
End If
ElseIf rng1.Find.Execute(FindText:="Procedure and Evaluation -") Then
Set rng2 = oWdoc.Range(rng1.End, oWdoc.Range.End)
If rng2.Find.Execute(FindText:="Design") Then
Text2 = oWdoc.Range(rng1.End, rng2.Start).text
Else
Text2 = ""
End If
Esle
Text1 = ""
Text2 = ""
GoTo NextIteration
End If
End If
Sheets("Temp").Cells(i, 6).Value = Text1
Sheets("Temp").Cells(i, 7).Value = Text2
Next
Cleanup:
oWdoc.Close
Set oWdoc = Nothing
oWord.Quit
Set oWord = Nothing
End Sub
问题更新:这是 Word Doc 的示例
方法编号:11111.1
A. 程序和评估 - aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
- Alkjaasdlkajghlja
- Jlasjdfkjasd;lfjlakdjs
设计
- - -分页符 - -
方法编号:22222.2
A. 设备 - bbbbbbbbbbbbbbbbbbbbbbbbbbbbb
- asdfsdf
- asdfasf
- asdfsdf
- asdfadf
- asdfsdf
B. 程序和评估 - cccccccccccccccccccccccccccccccccccc。
- Asdfasdfasdfasdf
设计
- - 分页符 - - -
如果我正在寻找方法编号:11111.1,那么我希望代码能够从“程序和评估 -”中获取信息并将其放在第 7 列中。对于方法编号:22222.2,我希望代码能够获取将“设备-”中的文字放在第 6 栏,将“程序和评估-”文字再次放在第 7 栏。
文档注意事项:
- 方法编号位于文本框中,其余文本正常 - 方法之间有分页符
解决方案
假设所有表达式都必须存在,按照您指定的顺序,尝试:
Sub Find_and_Copy()
Application.ScreenUpdating = False
Dim oWord As Word.Application, oWdoc As Word.Document
Dim xlWkSht As Worksheet, i As Long
Dim Text1 As String: Text1 = ""
Dim Text2 As String: Text2 = ""
Dim Text3 As String: Text3 = ""
Dim Fnd1 As String
Const Fnd2 As String = "Equipment -"
Const Fnd3 As String = "Procedure and Evaluation -"
Const Fnd4 As String = "Design"
Set xlWkSht = Sheets("Temp")
Set oWord = New Word.Application
Set oWdoc = oWord.Documents.Open("C:\Test.docx")
With xlWkSht
'Loop through rows searching for the Method Number, Equipment, Procedure, & Design
'Start on Row 4
For i = 4 To .Cells.SpecialCells(xlCellTypeLastCell).Row
'Check to make sure cell is not blank, if it is, then go to next iteration
If .Cells(i, 6).Value <> "" Then
'Set the Method Number to find
Fnd1 = Sheets("Temp").Cells(i, 6).Value & "."
With oWdoc.Range
With .Find
.ClearFormatting = True
.Replacement.ClearFormatting = True
.Replacement.Text = ""
.Forward = True
.Format = False
.Wrap = wdFindStop
.MatchWildcards = True
.Text = Fnd1 & "*" & Fnd2 & "*" & Fnd3 & "*" & Fnd4
.Execute
End With
If .Find.Found = True Then
Text1 = Split(Split(.Text, Fnd1)(1), Fnd2)(0)
Text2 = Split(Split(.Text, Fnd2)(1), Fnd3)(0)
Text3 = Split(Split(.Text, Fnd3)(1), Fnd4)(0)
End If
End With
End If
xlWkSht.Cells(i, 7).Value = Text1
xlWkSht.Cells(i, 8).Value = Text2
xlWkSht.Cells(i, 9).Value = Text3
Next
End With
oWdoc.Close False: oWord.Quit
Set oWdoc = Nothing: Set oWord = Nothing: Set xlWkSht = Nothing
Application.ScreenUpdating = True
End Sub
请注意,我已经更改了您的工作簿输出列;在我看来,您要在第 6 列中搜索某些内容,然后用空白或找到的文本替换它,这似乎与我不一致。
推荐阅读
- hive - Presto 与大表(9 亿条记录)的完全连接比 Hive 慢得多
- c++ - 输入 ID 号以在文本文件中查找
- c# - 考虑不同列上的最高值的记录上的 GroupBy
- python - 如何使用 ci.yml 声明要在 python 中使用的环境变量?
- javascript - 是否可以再减少我的代码?
- scala - 如何将 Scala 数据框中的所有小数列转换为双精度类型?
- html - 使用 BeautifulSoup 将标签包裹在 HTML 中的字符串周围
- arduino - 减少 ESP 32-Wroom-32D 微控制器的经典蓝牙范围
- airflow - 气流统计普罗米修斯映射规则
- python - 从 GCP 存储打开图像以使用 Vision API 处理它们时出现 TypeError