Excel 从网站中提取多个表

Question

我正在开展一个项目，对 NFL 球员统计数据运行一些分析模型。我下面有一些代码是另一个用户传递给我的。此代码获取 Sheet1 上的链接列表(名为“PlayerList”)，并为每个玩家创建一个新选项卡并提取他们的传球统计数据。所有链接均指向《职业足球引用》。我可以更改此代码以提取除四分卫以外的所有位置的所有必要数据。对于四分卫，我想提取传球统计表以及冲球和 catch 统计表。任何帮助将不胜感激。这里有一些示例链接可供引用:

https://www.pro-football-reference.com/players/R/RodgAa00.htm https://www.pro-football-reference.com/players/B/BreeDr00.htm

下面是代码:

Option Explicit
Public Sub GetInfo()
    Di  If InStr(links(link, 1), "https://") > 0 Then
            Set html = GetHTMLDoc(links(link, 1))
            Set hTable = html.getElementById("passing")
            If Not hTable Is Nothing Then
                playerName = GetNameAbbr(links(link, 1))
                Set ws = AddPlayerSheet(playerName)
                WriteTableToSheet hTable, ws
                FixTable ws
            End If
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Public Function GetHTMLDoc(ByVal url As String) As HTMLDocument
    Dim sResponse As String, html As New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", url, False
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With
    sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))
    html.body.innerHTML = sResponse
    Set GetHTMLDoc = html
End Function

Public Sub WriteTableToSheet(ByVal hTable As HTMLTable, ByVal ws As Worksheet)
    Dim x As Long, y As Long
    With hTable
        For x = 0 To .Rows.Length - 1
            For y = 0 To .Rows(x).Cells.Length - 1
                If y = 6 Or y = 7 Then
                    ws.Cells(x + 4, y + 1).Value = Chr$(39) & .Rows(x).Cells(y).innerText
                Else
                    ws.Cells(x + 4, y + 1).Value = .Rows(x).Cells(y).innerText
                End If
            Next y
        Next x
    End With
End Sub

Public Function GetNameAbbr(ByVal url As String)
    Dim tempArr() As String
    tempArr = Split(url, "/")
    GetNameAbbr = Left$(tempArr(UBound(tempArr)), 6)
End Function

Public Function AddPlayerSheet(ByVal playerName As String) As Worksheet
    Dim ws As Worksheet
    If SheetExists(playerName) Then
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets(playerName).Delete
        Application.DisplayAlerts = True
    End If
    Set ws = ThisWorkbook.Worksheets.Add
    ws.Name = playerName
    Set AddPlayerSheet = ws
End Function

Public Function SheetExists(ByVal playerName As String) As Boolean
    SheetExists = Evaluate("ISREF('" & playerName & "'!A1)")
End Function

Public Sub FixTable(ByVal ws As Worksheet)
    Dim found As Range, numSummaryRows As Long
    With ws
        Set found = .Columns("A").Find("Career")
        If found Is Nothing Then Exit Sub
        numSummaryRows = .Cells(.Rows.Count, "A").End(xlUp).Row - found.Row
        numSummaryRows = IIf(numSummaryRows = 0, 1, numSummaryRows + 1)
        Debug.Print found.Offset(, 1).Resize(numSummaryRows, 30).Address, ws.Name
        found.Offset(, 1).Resize(numSummaryRows, 30).Copy found.Offset(, 2)
        found.Offset(, 1).Resize(numSummaryRows, 1).ClearContents
    End With
End Subm html As New HTMLDocument, links(), link As Long, wsSourceSheet As Worksheet
    Dim hTable As HTMLTable, ws As Worksheet, playerName As String
    Set wsSourceSheet = ThisWorkbook.Worksheets("PlayerList")
    Application.ScreenUpdating = False
    With wsSourceSheet
        links = .Range("C2:C" & .Cells(.Rows.Count, "C").End(xlUp).Row).Value
    End With
    For link = LBound(links, 1) To UBound(links, 1)

Answer 1

您需要使用 VBA 执行此操作有什么原因吗？ Excel 非常能够导入组织良好的数据，例如该页面上的[几个]表。

在数据选项卡下，单击来自网络，然后输入网站 URL。

^{点击图片放大}

接下来您将选择您想要的 table 。不要发疯 - 只获取您需要的内容，但您可以通过启用复选框来选择多个表格。

解析和组织页面上的所有数据可能需要很长时间...

返回工作表后，您将在右侧看到查询。右键单击查询并选择加载到...，然后选择表和表数据的位置。您还可以自定义大量其他属性；有一些教程描述了您可以做什么。

更多需要自定义的内容隐藏在两个功能区选项卡中，这两个选项卡仅在您单击表格时才会显示:设计和查询。

我认为还有一种方法可以只创建玩家列表，然后在输入 URL 时使用高级选项，以允许您动态选择所需的任何玩家，同时仅添加表格曾经...但是我还没有完全弄清楚那部分。

我不是体育迷，但我认为整个赛季的数据都会发生变化，使用这样的表格的一个优点是，一旦您按照自己的意愿设置了工作表，就可以选择一些设置每次打开工作簿时自动更新、或按计划、或手动更新、或从不更新；任何合适的。

Google“Excel 网络查询”，了解有关使用查询时可用的大量选项的更多信息(又名:“获取和转换”) strong>") 来提取和组织您的数据。

也许这可以作为替代方案来考虑，而不是使用 Excel 内置的编码功能。

祝你好运，“去运动吧!”