Question

因此，我首先要说我是VBA的新手。我正在尝试从this page上的表中提取数据。就代码执行而言，我还没有完成很多，所以请放轻松。我正在寻找有关如何实现它以及是否可以实现的一些指导，我相信可以做到。如果有人能够帮助我指导正确的方向，那将不胜感激。

Sub rgnbateamstats()

Dim appIE As Object
Set appIE = CreateObject("internetexplorer.application")


With appIE
.navigate "https://rotogrinders.com/team-stats/nba-earned?site=draftkings"
.Visible = True
End With

Do While appIE.Busy
DoEvents
Loop

Set allRowOfData = appIE.document.getElementById("proj-stats")

不太确定从这儿去哪里，或者我什至不在正确的轨道上。

Answer 1

这将获取该页面上的整个表格。

该项目使用early-binding。您需要设置引用至：


Microsoft Internet控件

Microsoft HTML对象库


您可以在VBE>工具>参考中完成此操作。

我会说，这个站点使用一种非常奇怪的方法来设置他们的表，很有趣的是找到了一种不错的方法来完成此操作。

此外，您可能会或可能不会同意的另一件事是，此表中有 hidden （隐藏）列，这些列未显示在网站上，但会显示在您的excel文档中。如果您对此不满意，则可以在执行此代码后简单地删除或隐藏它们-或者如果您打算修改此代码以防止在执行过程中发生这种情况，那么将为您提供更多的功能。

Option Explicit

Sub rgnbateamstats()

    Const url$ = "https://rotogrinders.com/team-stats/nba-earned?site=draftkings"

    Dim IE As New InternetExplorer, doc As HTMLDocument
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)

    With IE
        .Navigate url
        .Visible = True
        ieBusy IE
        Set doc = .Document
    End With

    Dim r As Long, c As Long, tCol As HTMLDivELement
    Dim subTbls(): subTbls = Array("rgt-bdy left", "rgt-bdy mid", "rgt-bdy right")

    Dim subTbl As Long        
    For subTbl = 0 To 2
        For Each tCol In getSubTblCols(doc, subTbls(subTbl)).getElementsByClassName("rgt-col")
            c = c + 1
            For r = 1 To tCol.getElementsByTagName("div").Length
                ws.Cells(r, c) = tCol.getElementsByTagName("div")(r - 1).innerText
            Next
        Next tCol
    Next subTbl

End Sub

Private Function getSubTblCols(doc As HTMLDocument, ByVal className$) As HTMLDivElement
    Dim tbl As HTMLTable
    Set tbl = doc.getElementById("proj-stats")
    Set getSubTblCols = tbl.getElementsByClassName(className)(0).Children(0). _
            Children(1)
End Function

Private Sub ieBusy(ieObj As InternetExplorer)
    With ieObj
        Do While .Busy Or .ReadyState < READYSTATE_COMPLETE
            DoEvents
        Loop
    End With
End Sub

好吧，是时候尝试这里发生的事情了。

表中有三个子表。这是解释它的最佳方法，但这意味着您将首先使用以下代码循环遍历每个子表：

For subTbl = 0 To 2

在该循环中，您将在此行中循环该子表的列：

For Each tCol In getSubTblCols(doc, subTbls(subTbl)).getElementsByClassName("rgt-col")

rgt-col是每个表中列的类名-因此至少该部分很容易。函数getSubTblCols获取数组subTbls()中子表的三个名称之一的主子表元素类名称。

c是您的Excel列号，r是行号。您还为每个HTML的行号使用了r，但是它使用了base 0，因此您必须减去1。

然后使用单元格的innerText属性获取单元格的值，将其放入电子表格中，然后冲洗并重复。

我将您忙碌的网页功能移到了新的子页面ieBusy。我还添加了.readyState属性，因为正如我在my comment中所述，.busy本身最多是不可靠的。

Answer 2

尽管表格布局可能看起来有些奇怪，但实际上只需要180的思考即可。您可以按类名称获取列，然后简单地循环行；而不是通常先行循环再行循环。

我使用CSS class selector来抓取querySelectorAll的列，即以列的类名作为目标。这将返回包含每个列的nodeList。下面是前两列的示例（当然，abbr不可见）。列中的每一行都位于div中，因此，如果我对列进行循环，则会通过获取关联的div标签集合来获取每一列中的行。然后，我简单地循环这些以进行写出。

Option Explicit
Public Sub GetInfo()
    Dim IE As New InternetExplorer, iColumns As Object, iRow As Object, i As Long, j As Long, r As Long, c As Long
    Application.ScreenUpdating = False
    With IE
        .Visible = True
        .navigate "https://rotogrinders.com/team-stats/nba-earned?site=draftkings"

        While .Busy Or .readyState < 4: DoEvents: Wend

        Set iColumns = .document.querySelectorAll(".rgt-col")

        With ThisWorkbook.Worksheets("Sheet1")
            For i = 0 To iColumns.Length - 1
                c = c + 1: r = 0
                Set iRow = iColumns.item(i).getElementsByTagName("div")
                For j = 0 To iRow.Length - 1
                    r = r + 1
                    .Cells(r, c) = iRow(j).innerText
                Next
            Next
        End With
        Application.ScreenUpdating = True
        .Quit
    End With
End Sub

参考文献：

VBA>工具>参考> Microsoft Internet控件

或更改为晚绑定：

Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")

Answer 3

尝试此部分以提取第一列

Set allrowofdata = appIE.document.getElementById("proj-stats")

Set newobj = allrowofdata.getElementsByClassName("rgt-col")(0)

For Each x In newobj.Children
r = r + 1
Cells(r, 1).value = x.innerText
Next x

我正在尝试使用Excel VBA抓取网站数据

3 个答案: