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

我在Word文档（.docx）中有很多表格，我想用简单的方法将它们导入到一个空白的Excel表格中。 Word文档中的表格不是相同的大小（行），有些行具有合并的单元格。

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

当我运行这个代码时，我得到一个错误：

运行时错误“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分裂细胞或作为一个使用

Answer 1

该错误是由于您无法通过使用SomeTable.Rows.Count和SomeTable.Columns.Count作为“网格引用”来迭代合并单元格的表的单元格。

这是因为一旦水平地合并了一行中的一个或多个单元格，那么该行的列计数减lessn-1，其中n是合并的单元格的数量。

所以在你的示例表中，列数是3，但是在第一行中没有第三列，因此是错误。

您可以使用Table对象的Cell方法返回的对象的Next方法遍历Table的单元集合。 对于每个单元格，您可以获取列和行索引并将它们映射到Excel。 但是，对于合并的单元格，您无法获得每个单元格的列跨度属性，因此需要查看“ Width属性以尝试并推断将哪些单元格合并以及多less。 实际上，在Excel工作表中重新创build一个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 

哪个可以导入这个表格：

像这样，进入一个工作表：

请注意，没有明确的方法AFAIK来解决围绕如何知道Bar3应跨越合并Excel列，或者我们希望Baz3在单元格D3 ，而不是C3的挑战。