Html table to array merge cell - VB

Формулировка задачи:

Добрый день!
Пытаюсь таблицу из html передать в массив без использования копирования на лист Excel. Все осложняется тем, что в таблице есть объединенные ячейки по горизонтали и вертикале. И как раз с этим у меня вопрос. На выходе мне нужен массив в котором вместо объединенных ячеек были бы соответствующие данные относящиеся к объединенным ячейкам.
для понимания простенький пример на картинке.

Sub merge_cells()

Dim oDom As Object: Set oDom = CreateObject("htmlFile")
Dim data As Variant
 
dann = ActiveWorkbook.Worksheets("îñíîâíîé").Cells(1, 1)

oDom.body.innerHTML = dann
Y = 1: x = 1
    
    With oDom.getElementsByTagName("table")(0)

        ReDim data(1 To .Rows.Length + 1, 1 To .Rows(1).Cells.Length + 1)
        t = 0
        a = .Rows.Length - 1
        For a1 = 0 To a
            b = .Rows(a1).Cells.Length - 1
            For b1 = 0 To b
            
                c = .Rows.Item(a1).Cells.Item(b1).colspan
                r = .Rows.Item(a1).Cells.Item(b1).rowspan
                
                    For i1 = 1 To c
                        For i2 = 0 To r - 1
                        n = .Rows.Item(a1).Cells.Item(b1).innerHTML
                        If Len(data(x + i2, Y)) = 0 Then
                        data(x + i2, Y) = n
                        Else
                        Y = Y + 1
                        data(x + i2, Y) = n
                        End If
                        
                        Next
                   Y = Y + 1
                Next
            Next
            Y = 1
            x = x + 1
        Next
    End With

ActiveWorkbook.Worksheets("îñíîâíîé").Cells(4, 1).Resize(UBound(data), UBound(data, 2)).Value = data
  
End Sub

Решение задачи: «Html table to array merge cell»

textual
                            Листинг программы 
                        

                            border=1cellspacing=0cellpadding=4width='50%'><table <span="" style="color: #ff0000;">   
<tbody><tr><td <span="" style="color: #ff0000;">rowspan=2>A</td><td <span="" style="color: #ff0000;">colspan=2>C</td><td <span="" style="color: #ff0000;">rowspan=3>E</td><td>~1
</td></tr><tr><td>B</td><td>~2</td><td <span="" style="color: #ff0000;">rowspan=2>F
</td></tr><tr><td <span="" style="color: #ff0000;">colspan=3>~3


</td></tr></tbody></table><table width="95%" border="0" bgcolor="#DDDDDD" cellspacing="0" cellpadding="4" style="border: solid 1px #888888; margin :10px"><tbody><tr height="1"><td style="font: bold 11px Arial;">+ Code</td></tr><tr style="display:none"><td style="font : xx-small Verdana,Arial; padding : 7px" bgcolor="#EFEFFF"><pre class="src lang-vbnet">Option Explicit

Sub merge_cells()
    Dim oDom As Object, oTable As Object, oRow As Object, oCell As Object
    Dim iRows As Integer, iCols As Integer
    Dim x As Integer, y As Integer
    Dim xx As Integer, yy As Integer
    Dim colspan As Integer, rowspan As Integer
    Dim real_y As Integer
    Dim txt As String
    Dim data()
Dim idx() As Byte
    
    Set oDom = GetObject("c:\temp\tablecells.htm", "htmlFile")
    DoEvents
    
    Set oTable = oDom.getElementsByTagName("table")(0)
    DoEvents
    
    'кол-во строк в таблице = кол-во "строк" в массиве
    iRows = oTable.rows.Length
    
    'кол-во "столбцов" в массиве
    For x = 0 To iRows - 1
        Set oRow = oTable.rows(x)
        real_y = 0
        For y = 0 To oRow.Cells.Length - 1
            real_y = real_y + oRow.Cells(y).colspan
        Next y
        If iCols < real_y Then iCols = real_y
    Next x
    
    ReDim data(1 To iRows, 1 To iCols)
    ReDim idx(1 To iRows, 1 To iCols)
    
    For x = 0 To iRows - 1
        Set oRow = oTable.rows(x)
        real_y = 1
        
        For y = 0 To oRow.Cells.Length - 1
            Set oCell = oRow.Cells(y)
            colspan = oCell.colspan - 1
            rowspan = oCell.rowspan - 1
            txt = oCell.innerText
            
While idx(x + 1, real_y) > 0
                real_y = real_y + 1
            Wend
            
            For xx = x + 1 To x + 1 + rowspan
                For yy = real_y To real_y + colspan
                    If Len(txt) > 0 Then
                        data(xx, yy) = txt
                    End If
idx(xx, yy) = 1
                Next yy
            Next xx
            
            real_y = real_y + colspan + 1
            
        Next y
    Next x
    
    Set oCell = Nothing
    Set oRow = Nothing
    Set oTable = Nothing
    Set oDom = Nothing
    
    '<debug></debug>
    For x = LBound(data) To UBound(data)
        Debug.Print x & ":[ ";
        For y = LBound(data, 2) To UBound(data, 2)
            Debug.Print y & ":[" & data(x, y) & "] ";
        Next y
        Debug.Print "]"
    Next x
    '
End Sub
</pre>
</td></tr></tbody></table><table width="95%" border="0" bgcolor="#DDDDDD" cellspacing="0" cellpadding="4" style="border: solid 1px #888888; margin :10px"><tbody><tr height="1"><td style="font: bold 11px Arial;">+ Immediate</td></tr><tr style="display:none"><td style="font : xx-small Verdana,Arial; padding : 7px" bgcolor="#EFEFFF"><pre class="src lang-vbnet">1:[ 1:[A] 2:[C] 3:[C] 4:[E] 5:[~1] ]
2:[ 1:[A] 2:[B] 3:[~2] 4:[E] 5:[F] ]
3:[ 1:[~3] 2:[~3] 3:[~3] 4:[E] 5:[F] ]
</pre>
</td></tr></tbody></table> 


        
                        