来自网络抓取的 Excel

Question

我想将所有 6 个表从 this website 拉到我的工作簿中。 （vs All，vs PG，vs SG，vs SF，vs PF，vs C）当我尝试在 excel 中使用 from web 选项并选择表格时，它只会拉入标题。这是为什么？目前我有一个“立即粘贴”按钮，然后我转到网站，复制它并单击我用宏创建的“粘贴”按钮以清除当前信息并粘贴新值。我想消除我必须手动访问网站并复制表格的麻烦。除了“来自网络”之外，还有其他方法吗

Answer 1

确保您选择了正确的表。有两个表格元素。第一个只是标题。第二个是标题+信息。我不确定您是否可以使用此方法获取所有选项卡，因为 URL 不会更改并且内容已更新 javascript。您可以查看API 是否有任何可提供的东西，尽管它由想要在发布 API 密钥之前与您交谈的工作人员控制。

任何简单的方法是转到 VBE > 工具 > 参考 > 添加对 Microsoft Internet 控件的引用，然后使用 Internet Explorer 导航到该页面。

您可以使用CSS selector 通过其id 和另一个CSS 选择器class 来定位所有选项卡链接，以便单击它们以更新每个选项卡的表格。

Option Explicit

Public Sub GetInfo()
    Dim IE As New InternetExplorer, hTable As HTMLTable
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim clipboard As Object, tabs As Object, iTab As Long
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    With IE
        .Visible = True
        .navigate "https://swishanalytics.com/optimus/nba/daily-fantasy-team-defensive-ranks-position"

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

        Set tabs = .document.querySelectorAll(".position.fastClick")

        For iTab = 0 To tabs.Length - 1

            If iTab > 0 Then
                tabs.item(iTab).Click
                While .Busy Or .readyState < 4: DoEvents: Wend

            End If

            clipboard.SetText .document.querySelector("#stat-table").outerHTML
            clipboard.PutInClipboard

            With ws
                .Cells(GetLastRow(ws, 1) + 2, 1).PasteSpecial
            End With
        Next
        .Quit
    End With

End Sub

Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
    End With
End Function

---

如果您不想使用剪贴板复制粘贴表格，您可以循环其行和行内的表格单元格。

Option Explicit

Public Sub GetInfo()
    Dim IE As New InternetExplorer, ws As Worksheet, tabs As Object, iTab As Long
    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With IE
        .Visible = True
        .navigate "https://swishanalytics.com/optimus/nba/daily-fantasy-team-defensive-ranks-position"

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

        Set tabs = .document.querySelectorAll(".position.fastClick")

        For iTab = 0 To tabs.Length - 1
            If iTab > 0 Then
                tabs.item(iTab).Click
                While .Busy Or .readyState < 4: DoEvents: Wend
            End If

            WriteTable .document.querySelector("#stat-table"), GetLastRow(ws, 1) + 2, ws
        Next
        .Quit
    End With
    Application.ScreenUpdating = True
End Sub

Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
    End With
End Function

Public Sub WriteTable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)

    If ws Is Nothing Then Set ws = ActiveSheet

    Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, C As Long, tBody As Object
    r = startRow
    With ws
        Dim headers As Object, header As Object, columnCounter As Long
        Set headers = hTable.getElementsByTagName("th")
        For Each header In headers
            columnCounter = columnCounter + 1
            .Cells(startRow, columnCounter) = header.innerText
        Next header
        startRow = startRow + 1
        Set tBody = hTable.getElementsByTagName("tbody")
        For Each tSection In tBody
            Set tRow = tSection.getElementsByTagName("tr")
            For Each tr In tRow
                r = r + 1
                Set tCell = tr.getElementsByTagName("td")
                C = 1
                For Each td In tCell
                    .Cells(r, C).Value = td.innerText
                    C = C + 1
                Next td
            Next tr
        Next tSection
    End With
End Sub