Как извлечь данные из HTML div в Excel - PullRequest
1 голос
/ 20 сентября 2019

Я пытаюсь извлечь детали из этой веб-страницы, и они, кажется, находятся под определенными "divs" с "selection-left" и "selection-right" right.Я еще не нашел способ успешно вытащить его.Это URL - https://sports.ladbrokes.com/en-af/betting/golf/golf-all-golf/us-masters/2020-us-masters/228648232/

А вот изображение того, что я хочу извлечь.Я хочу скопировать название конкурса и каждого участника и балл.enter image description here

Я попытался использовать подход QHar в этой ссылке - Как извлечь значения из вложенных div, используя VBA .Но я получаю ошибки в этом направлении - результаты ReDim (1 к странам. Длина / 2, 1 к 4)

Вот код, который я пытался заставить работать

Option Explicit

Public Sub GetData()
Dim html As HTMLDocument, ws As Worksheet, countries As Object, scores As Object, results(), i As 
Long, r As Long

Set ws = ThisWorkbook.Worksheets("Sheet1"): Set html = New HTMLDocument: r = 1

With CreateObject("MSXML2.XMLHTTP")
    .Open "GET", "https://sports.ladbrokes.com/en-af/betting/golf/golf-all-golf/us-masters/2020-us-masters/228648232/", False
    .send
    html.body.innerHTML = .responseText
End With

Set participant = html.querySelectorAll(".market-content .selection-left"): Set scores = html.querySelectorAll("..market-content .selection-right")
ReDim results(1 To countries.Length / 2, 1 To 4)

For i = 0 To participant.Length - 1 Step 2
    results(r, 1) = participant.item(i).innerText: results(r, 2) = "'" & scores.item(i).innerText

    r = r + 1
Next
ws.Cells(1, 1).Resize(1, 4) = Array("Competition", "Participant", "Score")
ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub

Мне понадобится помощь, чтобы этот код работал

1 Ответ

0 голосов
/ 20 сентября 2019

Контент добавляется динамически, поэтому не будет присутствовать в текущем формате запроса;отсюда ваша ошибка, так как у вас есть nodeList длины 0. Вы можете попробовать делать POST-запросы, как это делает страница, но это не выглядит как быстрый и легкий код.Я бы пошел с автоматизацией браузера, если это небольшой проект, чтобы js мог запускаться на странице, и вы можете нажать кнопку показать больше.Вам потребуется условие ожидания для загрузки страницы.Я использую наличие кнопки показать больше.

Option Explicit

Public Sub GetOddsIE()
    Dim d As InternetExplorer, odds As Object, names As Object, i As Long
    Dim ws As Worksheet, results(), competition As String

    Set d = New InternetExplorer
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Const URL = "https://sports.ladbrokes.com/en-af/betting/golf/golf-all-golf/us-masters/2020-us-masters/228648232/"

    With d
        .Visible = False
        .Navigate2 URL
        While .Busy Or .ReadyState <> 4: DoEvents: Wend
        With .Document.getElementsByClassName("expandable-below-container-button")
            Do
                DoEvents
            Loop While .Length = 0  'wait for element to be present
            .Item(0).Click 'click on show more
        End With

        Set names = .Document.getElementsByClassName("selection-left-selection-name")
        Set odds = .Document.getElementsByClassName("odds-convert")
        competition = .Document.getElementsByClassName("league")(0).innerText

        ReDim results(1 To names.Length, 1 To 3)

        For i = 0 To names.Length - 1
            results(i + 1, 1) = competition
            results(i + 1, 2) = names.Item(i).innerText
            results(i + 1, 3) = "'" & odds.Item(i).innerText
        Next
        .Quit
    End With
    ws.Cells(1, 1).Resize(1, 3) = Array("Competition", "Participant", "Score")
    ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...