Извлечение значений HTML-элементов с использованием их классов

Question

Я посмотрел на решение, представленное в этой ссылке Извлечение таблицы из веб-страницы в Excel с использованием VBA , и это было очень полезно.Но мне нужно извлечь элементы с определенными классами в каждой ячейке таблицы HTML (td).

1. URL-адрес: https://www.betfair.com/exchange/plus/football/competition/11997260

2. Таблица HTMLкласс: таблица-купон

3. Цена для извлечения вложена в ячейки.Он находится в элементе Span с использованием класса "bet-button-price".Это данные, которые мне нужно извлечь в каждую ячейку на листе Excel.

Вот снимок экрана со структурой таблицы:

Буду признателен за помощь в извлечении этих цен в каждой ячейке на лист.

Public Sub GetInfo()
Const URL As String = "https://www.betfair.com/exchange/plus/football/competition/11997260"
Dim html As HTMLDocument, hTable As HTMLTable, ws As Worksheet, headers()
headers = Array("Countries", "Prices")
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set html = New HTMLDocument
With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", URL, False
    .send
    html.body.innerHTML = .responseText
End With
 Set hTable = html.querySelector("table.coupon-table")
Dim Td As Object, Tr As Object, r As Long, c As Long

r = 1
With ws
    .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
    For Each Tr In hTable.getElementsByTagName("tr")
        r = r + 1: c = 1
        If r > 3 Then
            For Each Td In Tr.getElementsByClassName("bet-button-price")
                .Cells(r - 2, c) = IIf(c = 2, "'" & Td.innerText, Td.innerText)
                c = c + 1
            Next
        End If
    Next
End With

End Sub

Answer 1

Я бы использовал ту же конечную точку, которую использует страница для обновления тех значений, которые возвращают json. Затем используйте синтаксический анализатор json, чтобы извлечь нужные значения.

Я использую jsonconverter.bas - вы добавляете код из этой ссылки в модуль с именем JsonConverter, затем идете VBE> Инструменты> Ссылки> Добавить ссылку на Microsoft Scripting Runtime.

В VBA для json [] обозначает коллекцию, к которой обращается For Each или по индексу, {} представляет словарь, доступ к которому можно получить по ключу или через For Each.

Я сохраняю результаты в массиве и записываю их за один раз для повышения эффективности. Вы можете написать в Activesheet.Cells(2,1) и затем добавить заголовки, если хотите, в строку 1.

Вы можете посмотреть пример ответа json здесь .

Option Explicit
Public Sub GetPrices()
    Dim s As String, json As Object, p As String

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.betfair.com/www/sports/exchange/readonly/v1/bymarket?_ak=nzIFcwyWhrlwYMrh&alt=json&currencyCode=GBP&locale=en_GB&marketIds=1.157348157,1.157348529,1.157347785,1.157347909,1.157348405,1.157348653,1.157348281,1.157349025,1.159492425,1.157348777,1.157348033,1.157348901,1.157350197,1.157350445,1.157351280,1.157349949&rollupLimit=10&rollupModel=STAKE&types=MARKET_STATE,MARKET_RATES,MARKET_DESCRIPTION,EVENT,RUNNER_DESCRIPTION,RUNNER_STATE,RUNNER_EXCHANGE_PRICES_BEST,RUNNER_METADATA,MARKET_LICENCE,MARKET_LINE_RANGE_INFO", False
        .send
        s = .responseText
        Set json = JsonConverter.ParseJson(s)
    End With

    Dim runners As Object, runner As Object, results(), r As Long
    Set runners = json("eventTypes")(1)("eventNodes")

    ReDim results(1 To runners.Count, 1 To 7)
    For Each runner In runners
        r = r + 1
        results(r, 1) = runner("event")("eventName")
        results(r, 2) = runner("marketNodes")(1)("runners")(1)("exchange")("availableToBack")(1)("price")
        results(r, 3) = runner("marketNodes")(1)("runners")(1)("exchange")("availableToLay")(1)("price")
        results(r, 4) = runner("marketNodes")(1)("runners")(3)("exchange")("availableToBack")(1)("price")
        results(r, 5) = runner("marketNodes")(1)("runners")(3)("exchange")("availableToLay")(1)("price")
        results(r, 6) = runner("marketNodes")(1)("runners")(2)("exchange")("availableToBack")(1)("price")
        results(r, 7) = runner("marketNodes")(1)("runners")(2)("exchange")("availableToLay")(1)("price")
    Next
    ActiveSheet.Cells(1, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub

---

Результаты:

Answer 2

вы пробовали getElementByClassName ("yourclassname")?