vba - Excel VBA 将包含合并单元格的 Word 表格导入 Excel

Question

我的 Word 文档 (.docx) 中有许多表格，我想以简单的方式将它们导入到空白 Excel 工作表中。 Word 文档中的表格大小(行)不一样，并且某些行具有合并单元格。

我的代码如下。我可以选择 .docx，然后选择要导入的表号，但我只能导入标题，所以我不知道是否可以正常工作。我这样做是因为我想保持表格格式(相同的行)，并且如果我使用复制/粘贴则无效。

当我运行此代码时，出现错误:

Run-time error '5941'. The requested member of the collection does not exist.

在这一行:

Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)

这是代码:

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel

wdFileName = Application.GetOpenFilename("Word files (*.docx),*.doc", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

Set wdDoc = GetObject(wdFileName) 'open Word file

With wdDoc
    TableNo = wdDoc.tables.Count
    If TableNo = 0 Then
        MsgBox "This document contains no tables", _
        vbExclamation, "Import Word Table"
    ElseIf TableNo > 1 Then
        TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
        "Enter table number of table to import", "Import Word Table", "1")
    End If
    With .tables(TableNo)
        'copy cell contents from Word table cells to Excel cells
        For iRow = 1 To .Rows.Count
            For iCol = 1 To .Columns.Count
                Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
            Next iCol
        Next iRow
    End With
End With

Set wdDoc = Nothing

End Sub

我的表格的格式如下:

<header> Same number of rows for all
6 rows with 2 columns
</header>
<content of the table>
<header1>3 columns combined<header1>
multiple rows with 3 columns
<header1>3 columns combined<header1>
multiple rows with 3 columns
</content of the table>

是这样的:

_______________________
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|______________________|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|
|______________________|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|
|_____|__________|_____|

抱歉表格格式，但我不知道如何更好地解释它。最终目标是将其保留在 Excel 中，如下所示:

_______________________
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|_________|____________|
|______________________||______________________|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|
|_____|__________|_____||_____|__________|_____|

如何在 Excel 中插入之前拆分合并的单元格？步骤是一一检测细胞，当只找到 1 个细胞时，将其分割或用作一个细胞

Answer 1

导致错误的原因是您无法使用 SomeTable.Rows.Count 和 SomeTable.Columns.Count 作为“grid”来迭代包含合并单元格的表格的单元格引用文献”。

这是因为一旦水平合并一行中的一个或多个单元格，该行的列数就会减少 n-1，其中 n 是合并单元格的数量。

因此，在您的示例表中，列数为 3，但第一行中没有第 3 列，因此出现错误。

您可以使用 Table 对象上的 Cell 方法返回的对象的 Next 方法来迭代该对象的单元格集合。 table 。对于每个单元格，您可以获得列索引和行索引并将它们映射到 Excel。但是，对于合并单元格，您无法获取每个单元格的列跨度属性，因此您需要查看宽度属性来尝试推断哪些单元格被合并以及合并了多少。事实上，在 Excel 工作表中重新创建 Word 表格将非常困难，因为该表格具有许多不同的单元格宽度并正在进行合并。

以下是如何使用 Next 方法的示例:

Option Explicit

Sub Test()

    Dim rng As Range

    Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1")

    CopyTableFromDocx "D:\test.docx", rng

End Sub

Sub CopyTableFromDocx(strMSWordFileName As String, rngTarget As Range)

    Dim objDoc As Object
    Dim lngTableIndex As Long
    Dim objTable As Object
    Dim objTableCell As Object
    Dim lngRowIndex As Long, lngColumnIndex As Long
    Dim strCleanCellValue As String

    On Error GoTo CleanUp

    'get reference to word doc
    Set objDoc = GetObject(strMSWordFileName)

    'handle multiple tables
    Select Case objDoc.Tables.Count
        Case 0
            MsgBox "No tables"
            GoTo CleanUp
        Case 1
            lngTableIndex = 1
        Case Is > 1
            lngTableIndex = InputBox("Which table?")
    End Select

    'clear target range in Excel
    rngTarget.CurrentRegion.ClearContents

    'set reference to source table
    Set objTable = objDoc.Tables(lngTableIndex)

    'iterate cells
    Set objTableCell = objTable.Cell(1, 1)
    Do
        'get address of cell
        lngRowIndex = objTableCell.Row.Index
        lngColumnIndex = objTableCell.ColumnIndex

        'copy clean cell value to corresponding offset from target range
        strCleanCellValue = objTableCell.Range.Text
        strCleanCellValue = WorksheetFunction.Clean(strCleanCellValue)
        rngTarget.Offset(lngRowIndex - 1, lngColumnIndex - 1).Value = strCleanCellValue

        Set objTableCell = objTableCell.Next
    Loop Until objTableCell Is Nothing

    'success
    Debug.Print "Successfully copied table from " & strMSWordFileName

CleanUp:
    If Err.Number <> 0 Then
        Debug.Print Err.Number & " " & Err.Description
        Err.Clear
    End If
    Set objDoc = Nothing

End Sub

可以导入这个表:

像这样，进入工作表:

请注意，据我所知，没有明确的方法可以解决如何知道 Bar3 应该跨越合并 Excel 列，或者我们希望 Baz3 位于单元格中的挑战 D3，而不是C3。