将所选文本设置为字符串并在范围内搜索字符串

Question

我在 Word 文档中有两个表格。

我想在 Table1 的 Column2（位于一个范围内）中搜索文本“yes”，如果找到，则选择左侧单元格中的文本（下例中的“John”）。
选择该文本后，我想将其设置为字符串，以便我可以搜索 Table2（位于第二个范围内）。

在 Table2 中找到字符串后，我想导航到行中的最后一列并复制其中的文本。
我想将文本粘贴到包含搜索到的原始“是”文本的 Table1 单元格中。
我希望循环以替换行上的更多“是”文本，以便 Table1 成为下面的新 Table1：

表格1：

姓名。	专栏2
约翰。	是的
吉尔。	-
简。	是的

表二：

姓名。	专栏2	第 3 栏	专栏4
约翰。			文案1
吉尔。
简。			复制文本2

新表 1：

姓名。	专栏2
约翰。	文案1
吉尔。
简。	复制文本2

我编写了 VBA 代码，该代码粘贴运行宏之前的最后复制文本，而不是从 column4 复制的文本。
我尝试分部分运行代码，但只有当我用实际文本替换字符串时它才有效（第 4 部分）。

Sub ReplaceYesWithCopyText()

Set oRng = ActiveDocument.Range
oRng.Start = oRng.Bookmarks("Bookmark1").Range.End
oRng.End = oRng.Bookmarks("Bookmark2").Range.Start

Dim str1 As String
Dim tbl As Table, r As Long
Set tbl = oRng.Tables(1)

For r = 1 To tbl.Rows.Count
    tbl.Cell(r, 3).Range.Select

    Set Rng = Selection.Range
    With Rng.Find
        .ClearFormatting
        .Font.Bold = True
            
'1. Search for yes in row 1 of column three
        .Execute FindText:="Yes", Format:=True, Forward:=True
        If .Found = True Then
                    
'2. Set cell to left as string
            tbl.Cell(r, 2).Range.Select
            str1 = Selection.Paragraphs(1).Range.Text
                    
'3. Set second range to search table 2
            Set oRng = ActiveDocument.Range
            oRng.Start = oRng.Bookmarks("Bookmark3").Range.End
            oRng.End = oRng.Bookmarks("Bookmark4").Range.Start
            oRng.Tables(1).Select
            Dim Fnd As Boolean
        
'4. Find name/string in tabke two
            Set Rng = Selection.Range
            With Rng.Find
                .ClearFormatting
                .Execute FindText:=str1, Forward:=True, _
                Format:=False, Wrap:=wdFindStop
                Fnd = .Found
            End With
        
'5. Navigating to colum 4 and copying cell text
            If Fnd = True Then
                With Rng
                   Selection.EndKey Unit:=wdLine
                    Selection.EndKey Unit:=wdLine
                    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
                    'str2 = Selection.Paragraphs(1).Range.Text
                    Selection.Copy
                End With
            End If
                            
'6. Set range back to table 1
            Set oRng = ActiveDocument.Range
            oRng.Start = oRng.Bookmarks("Bookmark1").Range.End
            oRng.End = oRng.Bookmarks("Bookmark2").Range.Start

'7. Find Yes in orginal column and paste info
            tbl.Cell(r, 3).Range.Select
            Selection.Paste
        End If
    End With
    Set Rng = Nothing
Next r

End Sub

Answer 1

例如：

Sub Demo()
Application.ScreenUpdating = False
Dim Tbl1 As Table, Tbl2 As Table, Rng1 As Range, Rng2 As Range, r As Long
With ActiveDocument
  Set Tbl1 = .Tables(1): Set Tbl2 = .Tables(2): Set Rng1 = .Tables(1).Range
  With Tbl1.Range
    With .Find
      .ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = True
      .MatchWholeWord = True
      .MatchWildcards = False
      .Text = "Yes"
      .Replacement.Text = ""
    End With
    Do While .Find.Execute = True
      If .InRange(Rng1) = False Then Exit Sub
      If .Cells(1).ColumnIndex = 2 Then
        r = .Cells(1).RowIndex
        Set Rng2 = Rng1.Tables(1).Cell(r, 1).Range: Rng2.End = Rng2.End - 1
        With Tbl2.Range
          With .Find
            .Text = Rng2.Text
            .Wrap = wdFindStop
            .Execute
          End With
          If .Find.Found = True Then
            Set Rng2 = Tbl2.Cell(.Cells(1).RowIndex, .Rows(1).Cells.Count).Range
            Rng2.End = Rng2.End - 1
            Rng1.Tables(1).Cell(r, 1).Range.FormattedText = Rng2.FormattedText
          End If
        End With
      End If
      .Collapse (wdCollapseEnd)
    Loop
  End With
End With
Application.ScreenUpdating = True
End Sub