Web Scraping: переформатировать информацию из таблицы HTML

Question

Я пытаюсь извлечь данные Futures из MRCI.com и преобразовать их в одну непрерывную таблицу на листе Excel, чтобы я мог оттуда манипулировать.

Как я могу повторить Фьючерсный контракт в каждой строке для получения следующего макета таблицы:

Структура таблицы

Вот мой код:

Sub MRCIData()

Dim XMLReq As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim FutTable As MSHTML.IHTMLElement
Dim FutRows As MSHTML.IHTMLElementCollection
Dim FutRow As MSHTML.IHTMLElement
Dim FutCells As MSHTML.IHTMLElementCollection
Dim FutCell As MSHTML.IHTMLElement
Dim FutContracts As MSHTML.IHTMLElementCollection
Dim FutContract As MSHTML.IHTMLElement
Dim FutRowText As String
Dim MrciURLHist As String

MrciURLHist = "https://www.mrci.com/ohlc/2020/200320.php"

XMLReq.Open "GET", MrciURLHist, False
XMLReq.send

If XMLReq.Status <> 200 Then
   MsgBox "Problem" & vbNewLine & XMLReq.Status & " - " & XMLReq.statusText
   Exit Sub
End If

HTMLDoc.body.innerHTML = XMLReq.responseText
Set XMLReq = Nothing

Set FutContracts = HTMLDoc.getElementsByClassName("note1")

    For Each FutContract In FutContracts

    Next

Set FutTable = HTMLDoc.getElementsByClassName("strat")(0)
Set FutRows = FutTable.getElementsByTagName("tr")

    For Each FutRow In FutRows
        Set FutCells = FutRow.getElementsByTagName("td")
        FutRowText = ""

            If InStr(FutRow.innerText, "Total Volume") = 0 Then

                For Each FutCell In FutCells

                    FutRowText = FutRowText & vbTab & FutCell.innerText

                Next

            End If

        Debug.Print , FutRowText

    Next

End Sub

Answer 1

Следующий код просматривает таблицу построчно и определяет, какое будущее применять к следующим строкам, пока не найдет следующую, и так далее. вывод не очень, так что это скорее подтверждение концепции. Код теперь выводит таблицу правильно.

Sub Main(ByVal Sheet As Worksheet)
Dim oRequest As New MSXML2.XMLHTTP60
Dim oDocument As New MSHTML.HTMLDocument
Dim oRows As MSHTML.IHTMLElementCollection
Dim oRow As MSHTML.IHTMLElement
Dim oCells As MSHTML.IHTMLElementCollection
Dim oCell As MSHTML.IHTMLElement

oRequest.Open "GET", "https://www.mrci.com/ohlc/2020/200320.php", False
oRequest.send

If oRequest.Status <> 200 Then
    MsgBox "Error"
    Exit Sub
End If

oDocument.body.innerHTML = oRequest.responseText

Set oRequest = Nothing

Dim Skip As Boolean
Dim Current As String
Dim RowIndex As Integer
Dim ColumnIndex As Integer

Set oRows = oDocument.getElementsByClassName("strat")(0).getElementsByTagName("tr")

Current = ""

Application.ScreenUpdating = False

For Each oRow In oRows
    Skip = False
    If oRow.getElementsByTagName("th").Length > 0 Then
        Current = oRow.innerText
        Skip = True
    End If
    If Not Current = "" And Skip = False Then
        If InStr(oRow.innerText, "Total Volume") = 0 Then
            Set oCells = oRow.getElementsByTagName("td")
            ColumnIndex = 2
            Sheet.Cells(RowIndex, 1).Value = Current
            For Each oCell In oCells
                Sheet.Cells(RowIndex, ColumnIndex).Value = oCell.innerText
                ColumnIndex = ColumnIndex + 1
            Next oCell
            RowIndex = RowIndex + 1
        End If
    End If
Next oRow

Application.ScreenUpdating = True

End Sub