用 VBA 抓取部分表格

问题描述 投票:0回答:1

我正试图在 https://data.goaloong.net/1x2/ 上抓取表格的 *5 列。 每一行都是单行。

*见屏幕

我当前的代码

Set http = New MSXML2.XMLHTTP
Set html = New HTMLDocument

url = "https://data.goaloong.net/1x2/"

http.Open "GET", url, False
http.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
http.send
    While http.readyState <> 4
        DoEvents
    Wend
html.body.innerHTML = http.responseText    
   
With Sheets("table")    
    Set HTMLAtab = html.getElementsByTagName("table")(0)

    For Each HTMLArow In HTMLAtab.Rows
        iRow = iRow + 1
        iCol = 0
        For Each HTMLAcel In HTMLArow.Cells
            iCol = iCol + 1
            Cells(iRow, iCol) = HTMLAcel.innerText
        Next HTMLAcel
    Next HTMLArow              
End With

期望的输出:

联赛 时间 离开 比较
阿联酋RL 17-03 14:45 阿吉曼保护区 Al-Wasl(右) http://.......
阿联酋RL 17-03 14:45 沙迦 (R) Al Ahli 迪拜保护区 http://.......
... ... ... ...

更新代码

    .Cells(i, 1) = html.getElementsByClassName("black-down f-white")(0).innerText
    .Cells(i, 2) = html.getElementsByClassName("en")(0).getAttribute("data-tf")
    .Cells(i, 3) = html.getElementsByClassName("team")(0).innerText
    .Cells(i, 4) = html.getElementsByClassName("td")(2).getElementsByTagName("a")(0).innerText

我尝试了各种方法,但还是失败了

vba xmlhttprequest scrape
1个回答
-1
投票

这是你想要的吗?

Sub TryThis()
    Dim HTMLDoc As New HTMLDocument
    Dim objTable As Object
    Dim lRow As Long
    Dim lngTable As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim ActRw As Long
    Dim objIE As InternetExplorer
    Set objIE = New InternetExplorer
    Dim sht As Worksheet
    Dim LastColumn As Long

    objIE.Navigate "https://data.goaloong.net/1x2/"

    Do Until objIE.ReadyState = 4 And Not objIE.Busy
        DoEvents
    Loop
    
    Set sht = ThisWorkbook.Worksheets("Sheet1")
    
    Application.Wait (Now + TimeValue("0:00:01"))
    HTMLDoc.body.innerHTML = objIE.Document.body.innerHTML
    With HTMLDoc.body
        Set objTable = .getElementsByTagName("table")
        For lngTable = 0 To objTable.Length - 1
            For lngRow = 0 To objTable(lngTable).Rows.Length - 1
                For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                If lngCol = 0 Or lngCol = 1 Or lngCol = 2 Or lngCol = 3 Or lngCol = 11 Or lngCol = 12 Then
                    ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
                End If
                Next lngCol
            Next lngRow
            ActRw = ActRw + objTable(lngTable).Rows.Length + 1
        Next lngTable
    End With
    objIE.Quit
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.