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

我在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个拆分单元格或作为一个使用时，会导致错误，因为您无法通过使用

SomeTable.Rows.Count

和

SomeTable.Columns.Count

作为“网格引用”对合并单元格的表中的单元格进行迭代

这是因为一旦水平合并了一行中的一个或多个单元格，则该行的列计数将减少n-1，其中n是合并的单元格数

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

您可以使用

Table

对象上的

Cell

方法返回的对象的

Next

方法来迭代表的单元格集合。对于每个单元格，可以获取列和行索引，并将它们映射到Excel。但是，对于合并的单元格，您无法为每个单元格获得列span属性，因此需要查看

宽度

属性，以尝试推断合并了哪些单元格以及合并的程度。事实上，在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

选项显式
子测试（）
变暗rng As范围
设置rng=ThisWorkbook.工作表（“Sheet1”）.范围（“A1”）
CopyTableFromDocx“D:\test.docx”，rng
端接头
子CopyTableFromDocx（strMSWordFileName作为字符串，rngTarget作为范围）
作为对象的Dim objDoc
Dim lngTableIndex尽可能长
作为对象的模糊对象
作为对象的Dim objTableCell
Dim lngRowIndex为长，lngColumnIndex为长
作为字符串的Dim strCleanCellValue
关于错误转到清理
'获取对word文档的引用
Set objDoc=GetObject（strMSWordFileName）
'处理多个表
选择Case objDoc.Tables.Count
案例0
MsgBox“无表”
去清理
案例1
lngTableIndex=1
病例>1
lngTableIndex=InputBox（“哪个表？”）
结束选择
'在Excel中清除目标范围
rngTarget.CurrentRegion.ClearContents
'设置对源表的引用
Set objTable=objDoc.Tables（lngTableIndex）
'迭代单元格
设置objTableCell=objTable.Cell（1,1）
做
'获取单元格的地址
LNROWINDEX=objTableCell.Row.Index
lngColumnIndex=objTableCell.ColumnIndex
'将干净单元格值复制到目标范围的相应偏移量
strCleanCellValue=objTableCell.Range.Text
strCleanCellValue=工作表函数.Clean（strCleanCellValue）
rngTarget.Offset（lngRowIndex-1，lngColumnIndex-1）。值=strCleanCellValue
设置objTableCell=objTableCell.Next
循环直到objTableCell为空
"成功",
Debug.Print“已成功从中复制表”&strMSWordFileName
清理：
如果错误号为0，则
调试。打印错误号和错误说明（&R）
呃，明白了
如果结束
设置objDoc=Nothing
端接头

哪个可以导入此表：

与此类似，输入工作表：

---

注意：对于如何知道

Bar3

应该跨合并Excel列，或者我们希望

Baz3

位于单元格

D3

，而不是

C3

，这就是我如何做到的，我使用select命令在word中选择表格，然后将其粘贴到Excel中

这将粘贴合并的单元格和所有单元格。从那里，如果需要进一步操作合并信息、清理格式或其他任何需要执行的操作，可以使用excel中的合并信息

本例将word文档中的所有表格复制到工作表中每个表格的新工作表中

Sub CopyWordTables()        
    Dim wdDoc As Word.Document
    Dim wdFileName As Variant

    wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
    "Browse for word documents")

    If wdFileName = False Then
        Exit Sub
    End If

    Set wdDoc = GetObject(wdFileName)

    If wdDoc.Tables.Count = 0 Then
        MsgBox "There are no tables in the selected document."
        Exit Sub
    End If

    Dim intTableCount As Integer
    intTableCount = 1

    For Each Table In wdDoc.Tables
        Table.Select
        wdDoc.Application.Selection.Copy
        Set Sheet = Sheets.Add(After:=ActiveSheet)
        Sheet.Name = "Table " & intTableCount
        intTableCount = intTableCount + 1
        Sheet.Select
        ActiveSheet.Paste
    Next

    Set wdDoc = Nothing
End Sub

---

请多告诉我出了什么问题。逻辑似乎很简单，所以您的输出出了什么问题。它显示了一个错误：运行时错误“5941”。请求的集合成员不存在。此错误将在以下行停止代码：Cells（iRow，iCol）=WorksheetFunction.Clean（.cell（iRow，iCol）.Range.Text）。在开始和结束时使用不同的列可能是错误的。因为两列行已正确导出。我将尝试将您的代码改编为我的代码并进行验证。我一有东西就把它寄出去。谢谢，我认为你应该不惜一切代价避免合并单元格。合并单元格有时看起来不错，但如果您必须在带有合并单元格的工作表上执行任何VBA工作，您将不可避免地遇到现在遇到的问题。只是一个解决方案，这使整个过程对我来说更有效：

lngRowIndex=objTableCell.Row.Index

应更正为

lngRowIndex=objTableCell.RowIndex

。然后它工作得很好：）谢谢！

Sub CopyWordTables()        
    Dim wdDoc As Word.Document
    Dim wdFileName As Variant

    wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _
    "Browse for word documents")

    If wdFileName = False Then
        Exit Sub
    End If

    Set wdDoc = GetObject(wdFileName)

    If wdDoc.Tables.Count = 0 Then
        MsgBox "There are no tables in the selected document."
        Exit Sub
    End If

    Dim intTableCount As Integer
    intTableCount = 1

    For Each Table In wdDoc.Tables
        Table.Select
        wdDoc.Application.Selection.Copy
        Set Sheet = Sheets.Add(After:=ActiveSheet)
        Sheet.Name = "Table " & intTableCount
        intTableCount = intTableCount + 1
        Sheet.Select
        ActiveSheet.Paste
    Next

    Set wdDoc = Nothing
End Sub