У меня есть некоторый код (спасибо другому пользователю), который открывает IE, переходит на веб-сайт, очищает данные и передает их обратно на мой лист.Код работает точно так, как и должен, но у меня есть небольшая проблема с ним.
Код выглядит следующим образом
'VBE > Tools > References:'1: Microsoft HTML Object library 2: Microsoft Internet Controls
Public Sub GetSoccerStats()
Dim ie As Object, t As Date
Dim objDoc As New MSHTML.HTMLDocument, text As String
Dim lastRow As Long, dataSheet As Worksheet, inputArray(), i As Long
Const MAX_WAIT_SEC As Long = 10
Set dataSheet = ThisWorkbook.Worksheets("AVG GOAL DATA")
Set ie = CreateObject("InternetExplorer.Application")
With dataSheet
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
inputArray = dataSheet.Range("C4:E" & lastRow).Value
inputArray = GetLinks(inputArray)
Dim results(), r As Long, c As Long
ReDim results(1 To UBound(inputArray, 1), 1 To 8)
With ie
.Visible = True
For i = LBound(inputArray, 1) To UBound(inputArray, 1)
r = r + 1
.navigate2 inputArray(i, 4)
While .Busy Or .readyState < 4: DoEvents: Wend
Dim objTable As MSHTML.HTMLTable, objTableRow As MSHTML.HTMLTableRow
Do
DoEvents
On Error Resume Next
Set objTable = .document.getElementsByClassName("table-main leaguestats")(0)
On Error GoTo 0
If Timer - t > MAX_WAIT_SEC Then Exit Do
Loop While objTable Is Nothing
If Not objTable Is Nothing Then
c = 1
For Each objTableRow In objTable.Rows
text = objTableRow.Cells(0).innerText
Select Case text
Case "Matches played", "Matches remaining", "Home goals", "Away goals"
results(r, c) = objTableRow.Cells(1).innerText
results(r, c + 1) = objTableRow.Cells(2).innerText
c = c + 2
End Select
Next objTableRow
End If
Next
.Quit
End With
dataSheet.Range("F4").Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub
Public Function GetLinks(ByRef inputArray As Variant) As Variant
Dim i As Long
ReDim Preserve inputArray(1 To UBound(inputArray, 1), 1 To UBound(inputArray, 2) + 1)
For i = LBound(inputArray, 1) To UBound(inputArray, 1)
inputArray(i, 4) = IIf(inputArray(i, 1) = "CURRENT", inputArray(i, 2), inputArray(i, 3))
Next
GetLinks = inputArray
End Function
Итак, у меня есть лист с списком футбольных лиг (в строках), затем столбцы содержат данные.Этот код извлекает данные с betexplorer.com и заполняет этот лист (каждая строка содержит данные, соответствующие лиге)
В данный момент этот код просматривает мой лист, чтобы увидеть, что если в столбце C слово CURRENT,затем используйте URL-адрес, указанный в столбце D. Если в столбце C содержится слово LAST, он берет URL-адрес из столбца E.
Проблема заключается в том, что некоторые лиги к концу сезона разделяются на группы (см. https://www.betexplorer.com/soccer/belgium/jupiler-league/stats/) Как вы заметили, когда вы попадаете на эту страницу, по умолчанию вы предоставляете статистику «группе чемпионатов», однако слева есть вкладка с надписью «главная». Это данные, которые мне нужны на главной вкладке.Еще одна проблема заключается в том, что не во всех лигах есть это. Насколько я могу судить, вкладка «главная» статистика имеет другой URL-адрес в теге HREF, поэтому, возможно, VBA может использовать ссылку, которую я предоставляю на листе, проверьте, чтобы увидетьесли существует «главная» вкладка, если ее нет, просто извлеките данные с этой страницы или перенаправьте ее на URL-адрес для «основной» вкладки и извлекитеданные с этого ...
HTML выглядит так:
<li class="list-tabs__item"><a href="?stage=z3r4t5sS" class="list-tabs__item__in">Main</a></li>
<li class="list-tabs__item"><a href="?stage=hrVVyPkq" class="list-tabs__item__in current">Championship Group</a></li>
<li class="list-tabs__item"><a href="?stage=EPykCdW0" class="list-tabs__item__in">Europa League Group</a></li>