HTML/VBA 下拉菜单并下载数据答案

【问题标题】：HTML/VBA dropdown menu and download the dataHTML/VBA 下拉菜单并下载数据
【发布时间】：2019-10-25 08:24:42
【问题描述】：

我有一个 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

【问题讨论】：

标签： html excel vba download

【解决方案1】：

@Davide Your For Each myItm In mycoll 循环运行 2 次，因为节点“table-main js-nrbanner-t”在 ie.document 中出现 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

【讨论】：