Excel 和 Word 文档之间的查找和替换过于复杂

Question

这是我当前的目标：

• 我有一个 Excel 文档，其中包含 n 行 2 列（C1 和 C2）数据
• 我有一个包含 n 个表格的 Word 文档，其中第一行 (R1) 包含 C2

我想在我的Word文档中添加基于R1==C2的表格中C1的内容。

我有一个工作项目可以做到这一点，但你可以清楚地看到复杂性是 N²，对于大量数据来说，它变得不可能完成......

这是我到目前为止所拥有的：

Set WA = CreateObject("Word.Application")
WA.Documents.Open (pathh)
WA.Visible = True
   
For j = 1 To WA.ActiveDocument.Tables.Count
 For i = 2 To N
     With WA.ActiveDocument.Tables(j).Range.Find
        .ClearAllFuzzyOptions
        .ClearHitHighlight
        .ClearFormatting
        .Text = Cells(i, 2)
        .Forward = False
        .Wrap = wdFindStop

        If .Execute Then
            WA.ActiveDocument.Tables(j).Rows(3).Cells(1).Range.Text = Cells(i, 1)
            Exit For
        End If
    End With
 Next
Next

任何帮助将不胜感激，谢谢！

Answer 1

假设每个表格中的第一个单元格仅包含您要用于标识表格的值。

Sub UpdateWordTables()
    Const PATHH = "C:\Users\Owner\Documents\Doc1.docx"
    Dim j As Integer, x As Long
    Dim key As String
    Dim r As Range, tbl As Object, WA As Object
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    With Worksheets("Sheet1")
        For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
            dict(r.Offset(0, 1).Text) = r.Text
        Next
    End With

    Set WA = CreateObject("Word.Application")
    WA.Documents.Open (PATHH)
    WA.Visible = True

    For Each tbl In WA.ActiveDocument.Tables

        With tbl
            key = .cell(1, 1).Range.Text
            'Trim Word Cell delimiters from text
            key = Left(key, Len(key) - 2)

            If dict.Exists(key) Then
                .cell(3, 1).Range.Text = dict(key)
            End If
        End With
    Next

    Set WA = Nothing
End Sub