Выпадающее меню HTML / VBA и загрузка данных - PullRequest
0 голосов
/ 25 октября 2019

У меня небольшая проблема с подпрограммой VBA, из-за которой я хотел бы загрузить только список чемпионатов (без матчей) дня с веб-сайта. https://www.betexplorer.com/next/soccer/ С помощью пользователя QHarr я смогизменить раскрывающееся меню с «Время начала» на «Лиги», чтобы список чемпионатов располагался в алфавитном порядке. Однако, когда я делаю итерации в таблице, чтобы загрузить названия чемпионатов (я повторяю без матчей), они берутся в порядке «Время начала матча», а не «Лиги». Как я мог сделать? Надеюсь, что будет ясно, я благодарю всех, кто может мне помочь. Это код, который я написал:

Sub Download()

    Dim ie As New SHDocVw.InternetExplorer
    Dim HTMLDoc As MSHTML.HTMLDocument

    Application.StatusBar = "Download Elenco Campionati odierni in corso..."
    Application.ScreenUpdating = False
    Application.Calculation = xlManual

    With ie
        .Visible = True
        .Navigate2 "https://www.betexplorer.com/next/soccer/"
        Do While .readyState <> READYSTATE_COMPLETE
        Loop
        '-------------------------------------------------------------
        'Thanks to User QHarr

        .document.querySelector("#nr-all [value='2']").Selected = True

        Set evt = .document.createEvent("HTMLEvents")
        evt.initEvent "change", True, False
        .document.querySelector("#nr-all select").dispatchEvent evt
        '-------------------------------------------------------------
    End With

    Set HTMLDoc = ie.document

    i = 9 'Riga di inizio copia dati
    j = 0 'Colonna di inizio copia dati

    Range("A10:A1005").ClearContents 'Pulisce la Zona dove saranno incollati i dati

    Set mycoll = HTMLDoc.getElementsByClassName("table-main js-nrbanner-t")


    For Each myItm In mycoll

        For Each trtr In myItm.Rows
            If trtr.classname = "js-tournament" Then
                inizio = InStr(trtr.innerHTML, "href=") + 6
                fine = InStr(trtr.innerHTML, "><i") - 1
                fedhtml = Trim(Mid(trtr.innerHTML, inizio, fine - inizio))
                campionato = Split(Replace(fedhtml, "/soccer/", ""), "/")
                campionato = Trim(campionato(1))
                    Cells(i + 1, j + 1) = trtr.innerText
                    Cells(i + 1, j + 1).Select
                    Selection.RowHeight = 15
                    i = i + 1
            End If
        Next trtr

    Next myItm

    'Chiusura IE
    ie.Quit
    Set ie = Nothing

    Calculate

    Application.Calculation = xlAutomatic
    Application.StatusBar = ""
    Application.ScreenUpdating = True

End Sub

1 Ответ

0 голосов
/ 25 октября 2019

@ Davide Your For Each myItm В цикле mycoll выполняется 2x, потому что узел "table-main js-nrbanner-t" встречается 2x в ie.document. 1-й в качестве стандартного порядка по умолчанию, 2-й в порядке, выбранном пользователем. Достаточно прочитать только второй цикл и все будет в порядке. Попробуйте что-то вроде этого:

SecondOccur = False
For Each myitm In mycoll
    If SecondOccur Then
        For Each trtr In myitm.Rows
            If trtr.classname = "js-tournament" Then
                inizio = InStr(trtr.innerHTML, "href=") + 6
                fine = InStr(trtr.innerHTML, "><i") - 1
                fedhtml = Trim(Mid(trtr.innerHTML, inizio, fine - inizio))
                campionato = Split(Replace(fedhtml, "/soccer/", ""), "/")
                campionato = Trim(campionato(1))
                    Cells(i + 1, j + 1) = trtr.innerText
                    Cells(i + 1, j + 1).Select
                    Selection.RowHeight = 15
                    i = i + 1
            End If
        Next trtr
    End If
    SecondOccur = True
Next myitm
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...