VBA 在 Word Doc 中选择范围，然后在 Excel 中粘贴范围

Question

我有多个文档，其中包含不同方法的设备和程序列表。我想要一个可以执行以下操作的代码：

第一个：在 Word Doc 中找到给定的方法编号

第二：查看方法编号以确定哪个在先，“设备-”或“程序和评估-”。 “设备-”，如果存在，则始终在“程序和评估-”之前，但如果“程序和评估-”在前，则“设备-”将不存在。

3rd：复制“设备-”和“程序和评估-”之间的文本范围（如果存在“设备-”）并粘贴到Excel中

4th：复制“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.程序和评估 - 啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊啊

1. Alkjaasdlkajghlja
2. Jlasjdfkjasd;lfjlakdjs

设计

-----分页符----

方法号：22222.2

A.设备 - bbbbbbbbbbbbbbbbbbbbbbbbbbbbb

1. asdfasdf
2. asdfasf
3. asdfasdf
4. asdfadf
5. asdfasdf

B.程序和评估 - cccccccccccccccccccccccccccccccccccc。

1. Asdfasdfasdfasdf

设计

----分页符-----

如果我正在寻找方法编号：11111.1，那么我希望代码能够从“程序和评估 -”中获取信息并将其放在第 7 列中。对于方法编号：22222.2，我希望代码是能够将“设备-”中的文字放入第6列，并将“程序和评估-”文字再次放入第7列。

关于文档的注释：
- 方法编号位于文本框内，其余文本正常 -Methods之间有分页符

Answer 1

假设所有表达式都必须存在，按照您指定的顺序，尝试：

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 列中搜索某些内容，然后用空白或找到的文本替换它。

Answer 2

尝试更改 macropod 的代码 .ClearFormatting' = True .Replacement.ClearFormatting' = True 这应该会让你更进一步。