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

以下是我目前的目标：

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

我想根据R1==C2将C1的内容添加到我的worddoc表中

我有一个工作项目要做，但你可以清楚地看到，复杂性是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

---

非常感谢您的帮助，谢谢

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

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

---

你考虑过使用缓存吗？一旦数据在一个循环中被分析，你就可以将它存储在某种缓存中，这样你就不必重新分析同一个文档。如果你的代码在工作，请考虑把它张贴在哪里，你可以在结构、算法和性能改进方面得到更多的帮助。@ PeterT Done，THX。