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

时间:2016-12-02 12:51:43

标签: excel vba excel-vba ms-word

我在Word文档(.docx)中有很多表,我想以简单的方式将它们导入到空白的Excel表格中。 Word文档中的表格大小(行)不同,有些行合并了单元格。

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

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

  

运行时错误' 5941'请求的集合成员不存在。

在这一行:

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分裂细胞或用作一个

1 个答案:

答案 0 :(得分:4)

导致错误是因为您无法使用SomeTable.Rows.CountSomeTable.Columns.Count作为&#39;网格参考&#39;来迭代包含合并单元格的表格的单元格。

这是因为一旦你在行中水平合并了一个或多个单元格,那么该行的列数会减少n-1,其中n是合并单元格的数量。

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

您可以在Next对象上使用Cell方法返回的对象的Table方法来遍历表的单元格集合。对于每个单元格,您可以获取列和行索引并将它们映射到Excel。但是,对于合并的单元格,您无法为每个单元格获取 列跨度 属性,这样您就需要查看Width属性以尝试推断出哪些单元格是合并了多少。实际上,在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

可以导入此表:

enter image description here

像这样,进入工作表:

enter image description here

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