Значение идентификатора диапазона не проверено с помощью Excel VBA - PullRequest
0 голосов
/ 29 марта 2019

У меня есть код Excel, который сопоставляет результаты совпадений с nowgoal.com, который недавно перестал работать, несмотря на отсутствие изменений в структуре страницы nowgoal

Ячейка AF2 содержит «1», что определяет, для каких данных строк следует собирать данные (в основном, каждая строка с номером 1, добавленным в столбец A, должна обрабатываться с учетом данных).

Каждая строка содержит идентификатор текущей цели (http://www.nowgoal.com/analysis/1401651.html - идентификатор 1401651), и домашние цели должны быть скопированы в столбец C, а цели в столбец D - в каждой соответствующей строке)

Это мой код:

Option Explicit
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Sub GetResult()

Const START_ROW As Integer = 3
Const START_COL As Integer = 3

Const ANALYSIS_PAGE As String = "http://www.nowgoal.com/analysis/"

Dim LString As String, LArray() As String

'get week number
Dim week As Integer: week = ActiveSheet.Cells(2, 32)

'instantiate worksheet to process
Dim wks As Worksheet: Set wks = ActiveSheet

'instantiate browser
Dim ie As New InternetExplorer
ie.Visible = True

'instantiate variables
Dim url As String, i As Integer, j As Integer
Dim nowGoalID As Long, iRow As Long, lastRow As Long

With wks

    lastRow = .Cells(Rows.Count, 1).End(xlUp).Row

    For iRow = START_ROW To lastRow

        'check week
        If .Cells(iRow, 1) <> week Or .Cells(iRow, 2) = "" Then GoTo nextRow
        Application.Goto .Cells(iRow, 1), True
        DoEvents

        nowGoalID = .Cells(iRow, 2)
        Application.StatusBar = "Processing row: " & iRow & " " & nowGoalID

        url = ANALYSIS_PAGE & nowGoalID & ".html"

        ie.navigate url
        While ie.Busy: DoEvents: Sleep 100: Wend
        While ie.readyState <> READYSTATE_COMPLETE: DoEvents: Sleep 100: Wend

        LString = Mid(ie.document.getElementById("mScore").innerText, 8)
        LArray = Split(LString, "-")

        Cells(70, 2).Value = LArray

nextRow:
Next iRow
End With

ie.Quit
Set ie = Nothing
MsgBox "All done", vbInformation
End Sub

Макрос открывает IE и находит нужный веб-сайт, однако очистка не выполняется

1 Ответ

1 голос
/ 29 марта 2019

Я думаю, вы можете объединить идентификатор в ajax xhr

Option Explicit    
Public Sub GetScores()
    Dim arr() As String, ws As Worksheet, ids(), id As Long
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ids = Array(1692803, 1401651)

    With CreateObject("MSXML2.XMLHTTP")
        For id = LBound(ids) To UBound(ids)
            .Open "GET", "http://www.nowgoal.com/Ajax.aspx?type=24&id=" & ids(id) & "&p=1553884659000", False
            .send
            If .Status = 200 Then
                arr = Split(.responseText, "-")
                ws.Cells(id + 1, "C") = arr(0): ws.Cells(id + 1, "D") = arr(1)
            End If
        Next
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...