如何使用vba将合并表从word导出到Excel

如何使用vba将合并表从word导出到Excel,excel,vba,ms-word,Excel,Vba,Ms Word,我无法将合并的word表导出到excel 这是我当前未合并表的代码 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 = Applicati

我无法将合并的word表导出到excel

这是我当前未合并表的代码

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 (*.docm),*.docm", , _
"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
End If
Set wdDoc = Nothing

End Sub
这不适用于合并的单元格;当我运行此脚本时,它在找到合并单元格时出错:

运行时错误“5941”:请求的集合成员不存在 存在

调试时,这是给出问题的行:Cells(iRow,iCol)=WorksheetFunction.Clean(.Cell(iRow,iCol).Range.Text)


如果我打开一个没有合并单元格的word文档,它会很好地提取数据。我需要从带有合并单元格的word文档中提取数据。是否可以更改代码以执行此操作?

合并单元格的问题是,您最终会遇到
.Columns.Count
大于行中单元格数的情况,因此会出现如下错误:

这应该工作,并处理垂直合并、水平合并或合并都是垂直和水平的,考虑一个单词表:

代码可以非常简化,不会在行/列/单元格上循环,只需使用(文档记录不良)方法复制和粘贴表格即可:

这基本上是的简化版本,但不幸的是,它没有保留合并的单元格:

如果要保留Word的格式,请执行以下操作:

.Tables(TableNo).Range.Copy
Range("A1").Activate
Application.CommandBars.ExecuteMso "PasteSourceFormatting"
它应该复制格式/etc:

如果需要保留合并区域但不保留单词格式,则只需将
“Normal”
样式应用于Excel中的结果区域:

.Tables(TableNo).Range.Copy
Range("A1").Activate
Application.CommandBars.ExecuteMso "PasteSourceFormatting"
Range("A1").CurrentRegion.Style = "Normal"

太棒了!谢谢,因为我对这个非常陌生(请原谅我的提问),我应该把这个放在我的原始代码中的什么地方?@B.Cole使用这个,而不是你的
和.Tables(TableNo)。。。以
block结束。太完美了!非常感谢@David Zemens
.Tables(TableNo).Range.Copy
Range("A1").Activate
Application.CommandBars.ExecuteMso "PasteSourceFormatting"
Range("A1").CurrentRegion.Style = "Normal"