在Excel和Word文档之间查找和replace的复杂度太高

这是我目前的目标:

  • 我有一个Excel文档,其中包含n行,包含2列(C1和C2)的数据
  • 我有一个Word文档包含n表至第一行(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 

任何帮助将是真正apreciated,谢谢!

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

 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