У меня небольшая проблема с подпрограммой 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