Cricinfo比分卡的HTML解析

Question

目的

我希望从Cricinfo网站抓取20/20板球比分数据，最好以CSV格式提取，以便在Excel中进行数据分析。

例如，当前的澳大利亚大破解2011/12得分卡可从以下链接获得：

• 第1场比赛：http://www.espncricinfo.com/big-bash-league-2011/engine/match/524915.html
• 上一场比赛：http://www.espncricinfo.com/big-bash-league-2011/engine/match/524935.html

背景

我擅长使用VBA（自动化IE或使用XMLHTTP然后使用正则表达式）从网站上抓取数据，如从HTML TD和Tr中提取值

在同一个问题中，发布了一个建议使用html解析的评论 - 这是我之前没有接触过的 - 所以我看了一些问题，例如RegEx匹配除XHTML自包含标记外的开放标记

查询

虽然我可以编写正则表达式来解析下面的板球数据，但我想知道如何使用html解析有效地检索这些结果。

请注意，我偏好重复使用的CSV格式，其中包含：

• 比赛日期/名称
• 第1支队伍名称
• 输出应该为Team 1的最多11条记录（球员没打过的空白记录，即"Did Not Bat"）
• Team 2名称
• 输出应该为Team 2的最多11条记录（球员没打过的空白记录）

对我而言，最理想的解决方案是我可以使用VBA或VBscript来部署，并完全自动化我的分析，但我认为我将不得不使用单独的工具来解析HTML。

示例网站链接和要提取的数据

- brettdj

---

只是一个简单的查询，我认为爬取Cricinfo是非法的！ - Aniruddha Chakraborty

Answer 1

我使用两种技术来处理 "VBA"。我将逐一介绍它们。

1) 使用 FireFox / Firebug Addon / Fiddler

2) 使用 Excel 内置的从 Web 获取数据的功能

由于此帖子将被许多人阅读，因此我将涵盖显而易见的内容。如果您已经知道，请随意跳过相关部分。

---

1) 使用 FireFox / Firebug Addon / Fiddler

---

FireFox： http://en.wikipedia.org/wiki/Firefox 免费下载 (http://www.mozilla.org/en-US/firefox/new/)

Firebug Addon： http://en.wikipedia.org/wiki/Firebug_%28software%29 免费下载 (https://addons.mozilla.org/en-US/firefox/addon/firebug/)

Fiddler： http://en.wikipedia.org/wiki/Fiddler_%28software%29 免费下载 (http://www.fiddler2.com/fiddler2/)

安装 Firefox 后，再安装 Firebug Addon。Firebug Addon 可让您检查网页中的不同元素。例如，如果您想知道按钮的名称，只需右键单击该按钮，然后单击“使用 Firebug 检查元素”，它将为您提供所需的所有详细信息。

另一个例子是查找包含所需数据的网站上的表格名称。

我仅在使用 XMLHTTP 时使用 Fiddler。当您单击按钮时，它可以帮助您查看传递的确切信息。由于爬取网站的 BOT 数量增加，大多数网站现在都会捕获您的鼠标坐标并传递该信息，而 Fiddler 实际上可帮助您调试正在传递的信息。我不会在这里详细介绍它，因为这些信息可能被用于恶意行为。

现在让我们以您的问题发布的 URL 为例，演示如何简单地进行数据获取。

http://www.espncricinfo.com/big-bash-league-2011/engine/match/524915.html

首先让我们找到包含信息的表的名称。只需右键单击该表并单击“使用Firebug检查元素”，就会给您以下快照。

现在，我们知道我们的数据存储在名为“inningsBat1”的表中。如果我们可以将该表的内容提取到Excel文件中，那么我们肯定可以处理数据以进行分析。这是一个示例代码，可将该表转储到Sheet1中

在继续之前，我建议关闭所有Excel并启动新实例。

启动VBA并插入Userform。放置一个命令按钮和一个webcrowser控件。您的Userform可能看起来像这样

将此代码粘贴到用户窗体代码区域中

Option Explicit

'~~> Set Reference to Microsoft HTML Object Library

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Sub CommandButton1_Click()
    Dim URL As String
    Dim oSheet As Worksheet

    Set oSheet = Sheets("Sheet1")

    URL = "http://www.espncricinfo.com/big-bash-league-2011/engine/match/524915.html"

    PopulateDataSheets oSheet, URL

    MsgBox "Data Scrapped. Please check " & oSheet.Name
End Sub

Public Sub PopulateDataSheets(wsk As Worksheet, URL As String)
    Dim tbl As HTMLTable
    Dim tr As HTMLTableRow
    Dim insertRow As Long, Row As Long, col As Long

    On Error GoTo whoa

    WebBrowser1.navigate URL

    WaitForWBReady

    Set tbl = WebBrowser1.Document.getElementById("inningsBat1")

    With wsk
        .Cells.Clear

        insertRow = 0
        For Row = 0 To tbl.Rows.Length - 1
            Set tr = tbl.Rows(Row)
            If Trim(tr.innerText) <> "" Then
                If tr.Cells.Length > 2 Then
                    If tr.Cells(1).innerText <> "Total" Then
                        insertRow = insertRow + 1
                        For col = 0 To tr.Cells.Length - 1
                            .Cells(insertRow, col + 1) = tr.Cells(col).innerText
                        Next
                    End If
                End If
            End If
        Next
    End With
whoa:
    Unload Me
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While Timer < nSec
       DoEvents
        Sleep 100
    Wend
End Sub

Private Sub WaitForWBReady()
    Wait 1
    While WebBrowser1.ReadyState <> 4
        Wait 3
    Wend
End Sub

现在运行您的用户窗体并单击命令按钮。您会注意到数据被转储在Sheet1中。请参见快照

同样，您也可以抓取其他信息。

---

2) 使用Excel内置的从Web获取数据功能

---

我相信您正在使用Excel 2007，因此我将以此为例来爬取上述链接。

导航到Sheet2。现在导航到数据选项卡，然后单击极右侧的“从Web”按钮。请参见快照。

在“新网络查询窗口”中输入网址，然后点击“Go”

页面上传后，通过单击快照中显示的小箭头选择要导入的相关表格。完成后，单击“导入”

然后Excel会问您要将数据导入哪里。选择相关单元格，然后单击“确定”。你就完成了！数据将被导入到您指定的单元格中。

如果您希望，您可以记录宏并自动化此过程 :)

这是我记录的宏。

Sub Macro1()
    With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://www.espncricinfo.com/big-bash-league-2011/engine/match/524915.html" _
    , Destination:=Range("$A$1"))
        .Name = "524915"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """inningsBat1"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

希望这可以帮到你。如果你还有疑问，请告诉我。 Sid

- Siddharth Rout

---

这个答案清晰且详细，我希望它能帮助brettdj。 - JMax

谢谢，Sid。虽然这个结果与我预期的不同，但是直接引用适当的HTML表格比解析更好。 - brettdj

Excel的强大，哈哈哈 :) - Sangram Nandkhile

来自未来的提示，使用WebBrowser控件创建用户窗体并不必要，因为代码会处理一切。 - Rick Henderson

Answer 2

如果还有其他人对此感兴趣，我最终使用了以下代码，基于Siddhart Rout的早期答案。

• XMLHttp比自动化IE快得多
• 该代码为每个要下载的系列生成一个CSV文件（保存在变量X中）
• 代码将每个匹配转储到普通29行范围内（无论有多少位球员击球），以便稍后更轻松地进行分析

    Public Sub PopulateDataSheets_XML()
    Dim URL As String
    Dim ws As Worksheet

    Dim lngRow As Long
    Dim lngRecords As Long
    Dim lngWrite As Long
    Dim lngSpare As Long
    Dim lngInnings As Long
    Dim lngRow1 As Long
    Dim X(1 To 15, 1 To 4) As String

    Dim objFSO As Object
    Dim objTF As Object

    Dim xmlHttp As Object
    Dim htmldoc As HTMLDocument
    Dim htmlbody As htmlbody
    Dim tbl As HTMLTable
    Dim tr As HTMLTableRow
    Dim strInnings As String

    s = Timer()

    Set xmlHttp = CreateObject("MSXML2.ServerXMLHTTP")
    Set objFSO = CreateObject("scripting.filesystemobject")

    X(1, 1) = "http://www.espncricinfo.com/indian-premier-league-2011/engine/match/"
    X(1, 2) = 501198
    X(1, 3) = 501271
    X(1, 4) = "indian-premier-league-2011"
    X(2, 1) = "http://www.espncricinfo.com/big-bash-league-2011/engine/match/"
    X(2, 2) = 524915
    X(2, 3) = 524945
    X(2, 4) = "big-bash-league-2011"
    X(3, 1) = "http://www.espncricinfo.com/ausdomestic-2010/engine/match/"
    X(3, 2) = 461028
    X(3, 3) = 461047
    X(3, 4) = "big-bash-league-2010"

    Set htmldoc = New HTMLDocument
    Set htmlbody = htmldoc.body


    For lngRow = 1 To UBound(X, 1)
        If Len(X(lngRow, 1)) = 0 Then Exit For
        Set objTF = objFSO.createtextfile("c:\temp\" & X(lngRow, 4) & ".csv")

        For lngRecords = X(lngRow, 2) To X(lngRow, 3)
            URL = X(lngRow, 1) & lngRecords & ".html"

            xmlHttp.Open "GET", URL
            xmlHttp.send
            Do While xmlHttp.Status <> 200
                DoEvents
            Loop
            htmlbody.innerHTML = xmlHttp.responseText

            objTF.writeline X(lngRow, 1) & lngRecords & ".html"
            For lngInnings = 1 To 2
            strInnings = "Innings " & lngInnings
                objTF.writeline strInnings

                Set tbl = Nothing
                On Error Resume Next
                Set tbl = htmlbody.Document.getElementById("inningsBat" & lngInnings)
                On Error GoTo 0
                If Not tbl Is Nothing Then
                    lngWrite = 0
                    For lngRow1 = 0 To tbl.Rows.Length - 1
                        Set tr = tbl.Rows(lngRow1)
                        If Trim(tr.innerText) <> vbNewLine Then
                            If tr.Cells.Length > 2 Then
                                If tr.Cells(1).innerText <> "Extras" Then
                                    If Len(tr.Cells(1).innerText) > 0 Then
                                        objTF.writeline strInnings & "-" & lngWrite & "," & Trim(tr.Cells(1).innerText) & "," & Trim(tr.Cells(3).innerText)
                                        lngWrite = lngWrite + 1
                                    End If
                                Else
                                    objTF.writeline strInnings & "-" & lngWrite & "," & Trim(tr.Cells(1).innerText) & "," & Trim(tr.Cells(3).innerText)
                                    lngWrite = lngWrite + 1
                                    Exit For
                                End If
                            End If
                        End If
                    Next
                    For lngSpare = 12 To lngWrite Step -1
                        objTF.writeline strInnings & "-" & lngWrite + (12 - lngSpare)
                    Next
                Else
                    For lngSpare = 1 To 13
                        objTF.writeline strInnings & "-" & lngWrite + (12 - lngSpare)
                    Next
                End If
            Next
        Next
    Next
    'Call ConsolidateSheets
End Sub

- brettdj

---

我给它点了个赞，但是里面有太多硬编码的信息，这不是我喜欢的风格，而且你可以想一个更好的变量名，比如说Y。 :) - Rick Henderson

@rickhenderson 感谢您的点赞 ;) 不太确定您所说的硬编码评论是指什么，除了最初的设置部分将代码指向适当的匹配系列？ - brettdj

@brettdj，你能分享一些带有标题的CSV样本吗？我正在寻找评论数据，我还想知道投球手打了什么样的球以及他在什么样的投递中的位置。 - Volatil3

Answer 3

RegEx并不是解析HTML的完整解决方案，因为它不能保证是正则的。

你应该使用HtmlAgilityPack来查询HTML。这将允许你使用CSS选择器来查询HTML，类似于使用jQuery一样。

- Babak Naffas

---

虽然感谢提供的链接，我会进一步查看它，但是考虑到有赏金在提供，我期望得到关于方法、工具的优缺点等方面的详细反馈。 - brettdj

Answer 4

作为许多人可能看到的内容，我想利用这个机会展示一些在VBA网页抓取中很少见到的功能：deleteRow、querySelector以及使用clipboard将表格（包括格式和超链接）写入基于table.outerHTML的工作表。

deleteRow用于删除不需要的行。 querySelector用于应用更快的CSS选择器匹配节点。现代浏览器/HTML解析器针对CSS进行了优化，而类选择器（我使用的）是第二快的选择器类型（仅次于ID）。

使用CSS选择器并理解htmlTable方法/属性将允许您在网页抓取方面具有更大的灵活性。了解剪贴板的使用意味着可以通过简单的复制粘贴方法将表格传输到Excel。

执行可以轻松地与按钮推送相结合，并从单元格中读取URL。

---

VBA:

Option Explicit

Public Sub test()

    WriteOutTable "https://www.espncricinfo.com/series/8044/scorecard/524935/hobart-hurricanes-vs-melbourne-stars-big-bash-league-2011-12"
    
End Sub

Public Sub WriteOutTable(ByVal url As String)
    'required VBE (Alt+F11) > Tools > References > Microsoft HTML Object Library ;  Microsoft XML, v6 (your version may vary)

    Dim hTable As MSHTML.HTMLTable, clipboard As Object
    Dim xhr As MSXML2.xmlhttp60, html As MSHTML.htmlDocument
   
    Set xhr = New MSXML2.xmlhttp60
    Set html = New MSHTML.htmlDocument

    With xhr
        .Open "GET", url, False
        .Send
        html.body.innerHTML = .responseText
    End With

    Set hTable = html.querySelector(".batsman")
    rowCount = hTable.Rows.Length - 1
    
    For i = rowCount To 0 Step -1
        Select Case True
        Case i = rowCount Or i = rowCount - 1 Or InStr(hTable.Rows(i).outerHTML, "wicket-details") > 0
            hTable.deleteRow i
        End Select
    Next

    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    clipboard.SetText hTable.outerHTML
    clipboard.PutInClipboard
    ActiveSheet.Cells(1, 1).PasteSpecial
    
End Sub

- QHarr