將數據從大型 Excel 文件傳輸到 Word 文檔中的多個表

Question

我正在嘗試將大型 excel 工作表中的數據傳輸到 Word 文檔中的小表格中。 我想通過匹配一行中的第一列然后將列中的單元格復制到行的右側來做到這一點。

例如，下面是 excel 文件中的表：

公司	名	姓
蘋果	湯姆	湯米
谷歌	安	安妮
亞馬遜	司機	泰德

在word文檔中有多個表。 我想填充與公司匹配的名稱。 現在表格看起來像這樣：

公司	名	姓
谷歌
亞馬遜

公司	名	姓
谷歌
蘋果

公司	名	姓
谷歌
亞馬遜
蘋果

我希望添加名稱，以便它們看起來像這樣：

公司	名	姓
谷歌	安	安妮
亞馬遜	司機	泰德

公司	名	姓
谷歌	安	安妮
蘋果	湯姆	湯米

公司	名	姓
谷歌	安	安妮
亞馬遜	司機	泰德
蘋果	湯姆	湯米

我願意接受任何可以幫助我做到這一點的選擇。 我正在嘗試郵件合並，但它似乎是勞動密集型的，而不是節省時間。 謝謝您的幫助。

Answer 1

對於第一種方法，您可以在要填寫表格的 MS Word 中使用此代碼。 代碼未優化，省略了錯誤檢查。 它期望命名范圍“MyData”存在並且恰好包含三列 [company, name1, name2]

'Add reference to the 'Microsoft Excel 16.0 Object Library' is required

Sub FillTablesFromExcel()
    
    Dim doc As Word.Document
    Set doc = ThisDocument
    
    Dim data
    data = ReadDataFromExcel
    
    Dim t As Word.Table
    For Each t In doc.Tables
        If t.Columns.Count <> 3 Then Exit For
        
        Dim r As Word.Row
        For Each r In t.Rows
            Dim txt As String
            txt = r.Cells(1).Range.Text
            company = Trim(Left(txt, Len(txt) - 2))
            
            For i = 1 To UBound(data)
                comp = data(i, 1)
                name1 = data(i, 2)
                name2 = data(i, 3)
                
                If company = comp Then
                    r.Cells(2).Range.Text = name1
                    r.Cells(3).Range.Text = name2
                End If
            Next
        Next
    Next

End Sub

Function ReadDataFromExcel()

    Dim xlsWorkbook As Excel.Workbook
    Set xlsWorkbook = Excel.Workbooks.Open("C:\Path\To\The\File.xlsx", ReadOnly:=True)
    
    Dim xlsSheet As Excel.Worksheet
    Set xlsSheet = xlsWorkbook.Sheets(1)
    
    Dim dataRange As Excel.Range
    Set dataRange = xlsSheet.Range("MyData")
    
    Value2 = dataRange.Value2
    
    Call xlsWorkbook.Close(False)
    ReadDataFromExcel = Value2
End Function