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个团队的ID。当我获得此信息时，可以以“ arsiv.mackolik.com/Basketball/Team/Default.aspx?id=44”的形式获取团队的统计信息。明确说明您对这些数字的关注。

Answer 1

我认为您仍然可以使问题更清楚。在最后一点/评论中：您可以使用css attribute = value选择器来收集每个团队链接，并从href中提取所需的数字。在下面，我收集了所需元素的nodeList并循环，将您的数字提取到数组codes中。在另一个维度中，我放置与该代码关联的名称。然后，您可以通过将当前数组的索引值连接到URL字符串中来循环数组的第一维以生成链接。

与您的硒脚本集成：

Dim list As Object, codes()
Set list = d.FindElementsByCss("[href^='javascript:popBasketTeam']")
ReDim codes(1 To list.Count, 1 To 2)
For i = 1 To list.Count
    codes(i, 1) = Replace$(Replace$(list(i).Attribute("href"), "javascript:popBasketTeam(", vbNullString), ")", vbNullString)
    codes(i, 2) = list(i).Text
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

不含硒：

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

再次，从网站接收数据的操作？

1 个答案: