Замедление может быть вызвано ограничением сети, если вы пытаетесь зайти на сайт слишком много раз подряд.Это особенно вероятно, учитывая ваш метод доступа.Лучше было бы посмотреть, доступен ли API для массового доступа к информации.Вы, вероятно, пройдете через много сетей, чтобы попасть на эту страницу.Может быть возможно получить некоторую основную информацию о задержках из команды TRACERT из командной строки.
Вы выполняете POST, поэтому помните, что на стороне сервера происходит довольно много вещей, посколькуЧто ж.
Вам не нужно устанавливать elem на Nothing, так как он существует только во время вашего For Loop.То же самое для tRow.
Помещение .getElementsByClassName("at_Galoplar")(0).Rows в переменную обеспечит более быструю ссылку.
Сначала запишите результаты в массив, а затем выведите массив на лист за один раз.обеспечить значительное улучшение скорости.
Использование ключевого слова New может привести к неожиданному поведению.Вы можете создать один экземпляр HTMLDocument и работать с ним при условии, что у вас будет хорошая обработка ошибок. У меня были случайные случаи в цикле, когда мне приходилось устанавливать HTMLDocument в Nothing перед повторным циклом.
Лично я бы обманул и переписал бы это для того, чтобы использовать GET-запросы для получения той же информации.Я использую класс для хранения объекта XMLHTTP и массив для хранения результатов.Я пишу результаты за один раз.Это займет несколько секунд, чтобы бежать за мной.Числа асей находятся в диапазоне Sheet1 A1:A84.
Модуль класса clsHTTP
Option Explicit
Private http As Object
Private Sub Class_Initialize()
Set http = CreateObject("MSXML2.XMLHTTP")
End Sub
Public Function GetString(ByVal url As String) As String
Dim sResponse As String
With http
.Open "GET", url, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
sResponse = StrConv(.responseBody, vbUnicode)
GetString = sResponse
End With
End Function
Стандартный модуль 1
Option Explicit
Public Sub DGaloplar()
Dim asays(), ws As Worksheet, asay As Long, html As HTMLDocument
Dim http As clsHTTP, url As String, headers(), numberOfRequests As Long
headers = Array("Asay", "Tarih", "Sehir", "Kg", "Jokey", "400", "600", "800", "1000", "1200", "1400", "Ç", "Pist", "Durum")
Set http = New clsHTTP
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set html = New HTMLDocument
asays = Application.Transpose(ws.Range("A1:A84").Value) 'Load asay values from sheet 1
Const numTableRows As Long = 11
Const numTableColumns As Long = 15
Const BASE_URL As String = "https://yenibeygir.com/at/getatdetaytab/?tab=galopTab&id="
numberOfRequests = UBound(asays)
Dim results(), headerRow As Boolean, tRows As Object, tRow As Object, iRow As Long
Dim tCells As Object, tCell As Object, r As Long, c As Long, hTable As HTMLTable
ReDim results(1 To numTableRows * numberOfRequests, 1 To numTableColumns)
Application.ScreenUpdating = False
For asay = 1 To numberOfRequests
headerRow = True
url = BASE_URL & asays(asay)
html.body.innerHTML = http.GetString(url)
Set hTable = html.querySelector(".at_Galoplar")
Set tRows = hTable.getElementsByTagName("tr")
For Each tRow In tRows
If Not headerRow Then
c = 2: r = r + 1
results(r, 1) = asays(asay)
Set tCells = tRow.getElementsByTagName("td")
For Each tCell In tCells
results(r, c) = tCell.innerText
c = c + 1
Next
End If
headerRow = False
Next
Next
With ws
.Cells(1, 3).Resize(1, UBound(headers) + 1) = headers
.Cells(2, 3).Resize(UBound(results, 1), UBound(results, 2)) = results
End With
Application.ScreenUpdating = True
End Sub
Ссылки:
- Библиотека объектов Microsoft HTML