将具有重复项的列转置为VBA中数组中具有匹配值的行

Question

我有一项任务，我已经达成了一个障碍。我是VBA的新手，在我完成这项任务时，我正在学习它

我有200封电子邮件，每封包含一个嵌入电子邮件正文中的html表

我需要遍历所有电子邮件并提取html表中包含的数据

表格如下所示。

html表数据

我的代码到目前为止创建了一个数组，用于为每封电子邮件生成标识符，即收到日期的属性。然后它将html表中的数据转换为数组。我有这个工作，但是当桌子分开并继续下面，新的＆＃39;表格标题在列中丢失，因为它为“顶部”创建了一个数组。和＆＃39;底部＆＃39;一起吃饭。

即。表格尺寸为26行乘23列，其中应为13行乘35列（将下表中的列添加到第一个表的末尾之后）

Option Explicit

Sub test()

Dim olApp As Outlook.Application, olNs As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder, olMail As Outlook.MailItem
Dim i, j, k As Long
Dim creationDate As Date
Dim butaneDatesArr() As Variant 'creating an array to hold the creation date of each email
Dim Item As Outlook.MailItem
Dim htmlArr() As Variant
Dim table As Object
Dim productsDict As Scripting.Dictionary 'call scripting reference
Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument
Dim eleColtr As MSHTML.IHTMLElementCollection 'Element Collection for tr tags
Dim eleColtd As MSHTML.IHTMLElementCollection 'Element Collection for td tags
Dim numberofColumns As MSHTML.IHTMLElementCollection
Dim obj1 As Object
Dim eleRow As MSHTML.IHTMLElement 'Row Elements
Dim eleCol As MSHTML.IHTMLElement 'Column Element

Dim a As Object
'Dim htmlTable As htmlTable

Dim headerValues As Variant
Dim headerRow() As String
Dim data() As String
Dim Counter As Integer

Dim numberofRows As Long

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders("Butane Forward Curves")

For Each Item In olFolder.Items
    Debug.Print Item.Subject
Next

ReDim butaneDatesArr(1 To olFolder.Items.Count, 0)
For i = LBound(butaneDatesArr) To UBound(butaneDatesArr)

    butaneDatesArr(i, 0) = olFolder.Items(i).LastModificationTime

 Next i

 For Each Item In olFolder.Items

    oHTML.Body.innerHTML = Item.HTMLBody
    Set eleColtr = oHTML.getElementsByTagName("tr") ' gives the number of rows
    Set numberofColumns = oHTML.getElementsByTagName("tr")(1).getElementsByTagName("td") ' Get all the td elements in that specific tr
    Set eleColtd = oHTML.getElementsByTagName("td") ' gives total number of elements in the table

＆＃39;为每行/列构建一个数组，以存储产品名称和数据

    ReDim htmlArr(0 To (eleColtr.Length - 1), 0 To (numberofColumns.Length - 1)) 'set array dimensions 11 by 23, htmlArr(11, 23)
    For j = LBound(htmlArr, 1) To UBound(htmlArr, 1)  'loop through rows dim 0 - 10
            Set ObjTr = oHTML.getElementsByTagName("tr")(j)

            For k = LBound(htmlArr, 2) To UBound(htmlArr, 2) 'loop over cols 0 - 22

            htmlArr(j, k) = ObjTr.getElementsByTagName("td")(k).innerText

            Next k
    Next j

Next Item

End Sub

如何将底部表格添加到VBA中第一个表格的末尾？ 我想这会非常繁琐！