VBA Excel to Word 问题：尝试从同一行传输多个数据

Question

我最近刚刚进入 VBA 尝试从 Excel 到 Word 文档进行实验，遵循这篇文章和示例： https : //www.makeuseof.com/tag/integrate-excel-data-word-document/

我试图用该代码进行一些实验，通过将行、字母和日期从 excel 提取到 word 到“表单”中，使用非常简单的代码（仍处于测试的早期阶段等等）：

    Private Sub Document_Open()
            Dim objExcel As New Excel.Application    
            Dim exWb As Excel.Workbook
            Set exWb = objExcel.Workbooks.Open("C:\Users\testing.xlsm")

            ThisDocument.row.Caption = exWb.Sheets("Sheet1").Cells(2,1)
            ThisDocument.letter.Caption = exWb.Sheets("Sheet1").Cells(2, 2)
            ThisDocument.date.Caption = exWb.Sheets("Sheet1").Cells(2, 3)            
            Set exWb = Nothing
End Sub

从这个 Excel '表格'：在此处输入图像描述到 Word，所以它看起来像这样：在此处输入图像描述

我现在要做的是将代码写入如果有多行具有相同的数字（在图片上，您可以看到第 3 行有三个 3，带有各自的字母/日期），它将信息拉入类似于下表的字词：

在此处输入图片说明

如果一个数字相同，我怎么能把它写到哪里，只提取这些数字中的一个（在这种情况下，只有 1 行 #）及其各自的字母和日期，都在一个之内。

请让我知道这是否有意义，或者您可以给我任何指导。 谢谢！

Answer 1

对于此解决方案，我使用 Excel 表格 ( ListObjects ) 而不是 Excel Range，因为使用DataBodyRange属性将其转换为数组更容易。 打开 Excel 文件，选择包含数据的范围，然后单击“ Home选项卡中的“ Format As Table dropdown菜单，选择其中一种样式。 在 Format As Table 窗口中，选中My table has headers复选框，然后单击OK 。 保存并关闭它，然后返回到 Word。

关于下面的代码，我专注于从 Excel 中获取数据并将其写入 Word 表格的单元格内，暂时忽略格式。 请让我知道此代码是否是您需要的起点，或者是否需要其他任何内容。

Sub CreateForm()

    Dim xlApp As New Excel.Application
    
    Dim wb As Excel.Workbook
    Set wb = xlApp.Workbooks.Open(ThisDocument.Path & "\TestFile.xlsx")
    
    Dim ws As Excel.Worksheet
    Set ws = wb.Worksheets("Sheet1")
    
    Dim numRows, numColumns As Integer
    numRows = ws.ListObjects("Table1").ListRows.Count
    numColumns = 3
    
    Dim arrTable As Variant
    arrTable = ws.ListObjects("Table1").DataBodyRange
    
    Dim tbl As Table
    Set tbl = ThisDocument.Tables.Add(Selection.Range, numRows + 1, numColumns)
    
    With tbl
        .Cell(1, 1).Range.InsertAfter "Row:"
        .Cell(1, 2).Range.InsertAfter "Letter:"
        .Cell(1, 3).Range.InsertAfter "Date:"
    
         Dim i, previousNumber As Integer
         For i = LBound(arrTable) To UBound(arrTable)
            If previousNumber <> arrTable(i, 1) Then
                .Cell(i + 1, 1).Range.InsertAfter arrTable(i, 1)
            End If
            previousNumber = arrTable(i, 1)
            
            .Cell(i + 1, 2).Range.InsertAfter arrTable(i, 2)
            .Cell(i + 1, 3).Range.InsertAfter arrTable(i, 3)
         Next
    
    End With
    
    wb.Close
    Set xlApp = Nothing
    
End Sub