Excel VBA Import Word таблица с объединенными ячейками в Excel

Question

У меня есть много таблиц в документе Word (.docx), и я хочу легко импортировать их на пустой лист Excel. Таблицы в документе Word не имеют одинаковый размер (строки), а некоторые строки объединяют ячейки.

Мой код приведен ниже. Я могу выбрать .docx, а затем выбрать номер таблицы для импорта, но я могу импортировать заголовки, поэтому я не знаю, работает ли это нормально. Я делаю это, потому что хочу сохранить формат таблиц (те же строки) и недействителен, если я использую copy/paste.

Когда я запускаю этот код, я получаю сообщение об ошибке:

Run-time error '5941'. The requested member of the collection does not exist.

На этой линии:

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 как «ссылки на сетку».

Это связано с тем, что после горизонтального объединения одной или нескольких ячеек в строке количество столбцов для этой строки уменьшается на n-1, где n - количество объединенных ячеек.

Итак, в таблице примеров столбец равен 3, но в первой строке нет столбца, следовательно, ошибка.

Метод Next объекта, возвращенного методом Cell объекта Table, для итерации по ячейке коллекции таблицы. Для каждой ячейки вы можете получить индексы столбцов и строк и сопоставить их с Excel. Тем не менее, для объединенных ячеек вы не можете получить пространство для каждой ячейки, чтобы вы могли посмотреть на свойства Width, чтобы определить, какие ячейки объединены и на сколько. На самом деле, будет очень сложно воссоздать таблицу Word в листе Excel, где в таблице много разных ширины ячеек и происходит слияние.

Вот пример того, как использовать 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.