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



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

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

最新更新