Опять же операция получения данных с сайта?

Question

Я хотел бы получить данные из "http://arsiv.mackolik.com/Program/Program.aspx?st=1" или" http://arsiv.mackolik.com/Program/Program.aspx?st=2". Но как я могу получить данные с кодом "weekac".Я также хочу получать данные со ссылками.

Public Sub Iddaa_Sonuc()
    Application.ScreenUpdating = False
    Dim i As Long
For i = 3 To 3
    Sheets("@").Select
    Range("A1").Select
    Dim d As WebDriver, clipboard As Object, ele As Object, ws As Worksheet, t As Date, html As HTMLDocument, weeks As Object
    Const MAX_WAIT_SEC As Long = 15
    Set ws = ThisWorkbook.Worksheets("@")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Set d = New ChromeDriver
    Const URL = "http://arsiv.sahadan.com/Iddaa/Program.aspx?st=1"
    With d
        .Start "Chrome"
        .get URL, timeout:=90000
        Set weeks = .FindElementsByCss("#weekac option")
                    .FindElementsByCss("#weekac option")(i).Click
            Set html = New HTMLDocument
            t = Timer
            Do
                DoEvents
                On Error Resume Next
                Set ele = .FindElementByCss("#iddaa-tab-body #resultsList")
                On Error GoTo 0
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While ele Is Nothing
            If Not ele Is Nothing Then
                clipboard.SetText ele.Attribute("outerHTML")
                clipboard.PutInClipboard
                ws.Cells.UnMerge
                Application.Wait Now + TimeSerial(0, 0, 1)
                ws.Cells(GetLastRow(ws, 1) + 1, 1).PasteSpecial
                Application.Wait Now + TimeSerial(0, 0, 3)
            End If
            Set ele = Nothing
        .Quit
    End With
    Cells.UnMerge
    Columns("A:A").Insert
    Range("A2").FormulaR1C1 = "=IF(OR(R[-1]C[1]=""Saat"",RC[4]=""Kod""),RC[1],R[-1]C)"
    Range("A2").Copy
    Range("A2:A" & Range("B1048576").End(xlUp).Row).PasteSpecial Paste:=xlPasteFormulas
    Columns("A:A").Copy
    Columns("A:A").PasteSpecial Paste:=xlPasteValues
    Cells.Replace What:=" ", Replacement:=""
    Cells.Replace What:=" ", Replacement:=""
    Columns("B:B").Replace What:="PM", Replacement:=" PM"
    Columns("B:B").Replace What:="AM", Replacement:=" AM"
    Range("D:D,F:F,K:K,O:AB,AF:AZ").Delete
    Range("O1").FormulaR1C1 = "=IF(RC[-7]=""v"",""#"",IF(ISNUMBER(RC[-8]),IF(YEAR(RC[-8])=YEAR(TODAY()),CONCATENATE(DAY(RC[-8]),""#"",MONTH(RC[-8])),CONCATENATE(MONTH(RC[-8]),""#"",RIGHT(YEAR(RC[-8]),2))),SUBSTITUTE(RC[-8],""-"",""#"")))"
    Range("Q1").FormulaR1C1 = "=IF(RC[-8]=""v"",""#"",IF(ISNUMBER(RC[-9]),IF(YEAR(RC[-9])=YEAR(TODAY()),CONCATENATE(DAY(RC[-9]),""#"",MONTH(RC[-9])),CONCATENATE(MONTH(RC[-9]),""#"",RIGHT(YEAR(RC[-9]),2))),SUBSTITUTE(RC[-9],""-"",""#"")))"
    Range("S1").FormulaR1C1 = "=IF(RC[-4]=RC[-3],0,IF(RC[-4]>RC[-3],1,-1))"
    Range("T1").FormulaR1C1 = "=IF(RC[-3]=RC[-2],0,IF(RC[-3]>RC[-2],1,-1))"
    Range("U1").FormulaR1C1 = "=IF(OR(ISBLANK(RC[-12]),RC[-12]=""-""),0,IF(ISNUMBER(RC[-12]),IF(YEAR(RC[-12])=YEAR(TODAY()),VALUE(CONCATENATE(DAY(RC[-12]),"","",MONTH(RC[-12]))),VALUE(CONCATENATE(MONTH(RC[-12]),"","",RIGHT(YEAR(RC[-12]),2)))),VALUE(SUBSTITUTE(RC[-12],""."","",""))))"
    Range("U1").Copy
    Range("U1:Z1").PasteSpecial Paste:=xlPasteFormulas
    Range("O1:Z1").Copy
    Range("O1:O" & Range("A1048576").End(xlUp).Row).PasteSpecial Paste:=xlPasteFormulas
    Columns("O:Q").Copy
    Columns("O:Q").PasteSpecial Paste:=xlPasteValues
    Columns("O:O").TextToColumns Destination:=Range("O1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="#", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    Columns("Q:Q").TextToColumns Destination:=Range("Q1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="#", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
    Cells.Copy
    Cells.PasteSpecial Paste:=xlPasteValues
    Columns("G:N").Delete
    ActiveWorkbook.Worksheets("@").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("@").Sort.SortFields.Add Key:=Range("D1:D1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("@").Sort
        .SetRange Range("A1:CC1048576")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D" & Columns("D:D").Find(What:="Kod", LookAt:=xlPart).Row & ":D1048576").EntireRow.Delete
    Range("A1:R" & Range("A1048576").End(xlUp).Row).Copy
    Sheets("Y").Range("A" & Sheets("Y").Range("A1048576").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    Application.DisplayAlerts = False
    Sheets("@").Delete
    Sheets.Add.Name = "@"
    Sheets("@").Move Before:=Sheets(1)
    Application.DisplayAlerts = True
Next
End Sub

Это мой код, но он не работает.

Когда вы открываете "arsiv.mackolik.com/Program/Program.aspx?st = 2 "в браузере, когда вы наводите указатель мыши на команды, ссылка, такая как" javascript: popBasketTeam (44) ", кажется, является идентификатором 44 команд здесь.Когда у меня есть эта информация, я могу получить статистику команды в форме "arsiv.mackolik.com/Basketball/Team/Default.aspx?id=44".Дайте понять, что вы после этих чисел.

Answer 1

Я думаю, вы все еще можете прояснить свой вопрос.Из вашего последнего замечания / комментариев: Вы можете использовать селектор css attribute = value , чтобы собрать каждую из ссылок группы и извлечь необходимое число из href.Ниже я собираю nodeList необходимых элементов и цикл, который извлекает ваши числа в массив codes.В другом измерении я помещаю имя, связанное с этим кодом.Затем вы можете зациклить первое измерение массива для генерации ваших ссылок, объединяя индексированное значение текущего массива в строку URL.*

---

---

Без селена:

Option Explicit
Public Sub GetLinks()
    Dim sresponse As String, html As HTMLDocument, list As Object, i As Long, codes()

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "http://arsiv.mackolik.com/Program/Program.aspx?st=2", False
        .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
        .send
       sresponse = StrConv(.responseBody, vbUnicode)
    End With

    Set html = New HTMLDocument
    html.body.innerHTML = sresponse
    Set list = html.querySelectorAll("[href^='javascript:popBasketTeam']")
    ReDim codes(list.Length - 1, 0 To 1)
    For i = 0 To list.Length - 1
        codes(i, 0) = Replace$(Replace$(list.item(i).href, "javascript:popBasketTeam(", vbNullString), ")", vbNullString)
        codes(i, 1) = list.item(i).innerText
    Next
    Dim newURL As String
    'Now loop codes dimension 1 i.e.
     For i = LBound(codes, 1) To UBound(codes, 1)
         newURL = "http://arsiv.mackolik.com/Basketball/Team/Default.aspx?id=" & codes(i, 1)
      ' Do something ........
    Next
End Sub