在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