我在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分裂细胞或用作一个
答案 0 :(得分:4)
导致错误是因为您无法使用SomeTable.Rows.Count
和SomeTable.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
可以导入此表:
像这样,进入工作表:
请注意,AFAIK没有明确的方法来解决有关如何知道Bar3
应该跨越合并Excel列,或者我们希望Baz3
位于单元格D3
中的挑战,而不是C3
。