html解析cricinfo记分卡

时间：2012-01-10 03:39:19

标签： html regex xml vba parsing

目标

我希望从Cricinfo website获取20/20板球记分卡数据，最好是 CSV格式，以便在Excel中进行数据分析

例如，澳大利亚Big Bash 2011/12记分卡可从

获取

背景

我精通使用VBA（自动IE或使用XMLHTTP然后使用正则表达式）从网站上抓取数据，即 Extract values from HTML TD and Tr

在同一个问题中，发表了一条评论，建议使用html解析 - 我之前没有遇到过 - 所以我看了RegEx match open tags except XHTML self-contained tags等问题

查询

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

请注意，我的偏好是一种可重复的CSV格式，其中包含：

  • 比赛的日期/名称
  • 第1组名称
  • 输出最多可以转移到第1组的11条记录（玩家没有击球的空白记录，即“没有击球”）
  • 第2队名称
  • 输出最多可以转移到第2组的11条记录（玩家没有击球的空白记录）

Nirvana对我来说是一个可以使用VBA或VBscript部署的解决方案，所以我可以完全自动化我的分析，但我认为我将不得不使用单独的工具进行html解析。

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

cricinfo scorecard source date

4 个答案:

答案 0 :(得分：50)

我使用了两种技术＆＃34; VBA＆＃34;。我将逐一描述它们。

1）使用FireFox / Firebug Addon / Fiddler

2）使用Excel的内置工具从网络上获取数据

由于这篇文章会被许多人阅读所以我甚至会介绍这个帖子。请随意跳过你知道的任何部分

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允许您检查网页中的不同元素。例如，如果您想知道按钮的名称，只需右键单击它，然后单击＆＃34;使用Firebug检查元素＆＃34;它将为您提供该按钮所需的所有详细信息。

enter image description here

另一个例子是在网站上找到一个表格的名称，该表格包含您需要报废的数据。

我在使用XMLHTTP时才使用Fiddler。它可以帮助我查看单击按钮时传递的确切信息。由于BOTS数量的增加，现在，大多数网站都在阻止自动报废，捕获鼠标坐标并传递信息，而fiddler实际上可以帮助您调试正在传递的信息。我不会在这里详细介绍它，因为这些信息可以被恶意使用。

现在让我们举一个关于如何抓取问题中发布的网址的简单示例

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

首先，让我们找到包含该信息的表的名称。只需右键单击表格，然后单击＆＃34;使用Firebug检查元素＆＃34;它会给你以下快照。

enter image description here

所以现在我们知道我们的数据存储在名为＆＃34; inningsBat1＆＃34;如果我们可以将该表的内容提取到Excel文件，那么我们绝对可以使用数据来进行分析。以下是将该表转储到Sheet1

中的示例代码

在我们继续之前，我建议关闭所有Excel并开始一个新的实例。

启动VBA并插入Userform。放置一个命令按钮和一个webcrowser控件。您的Userform可能如下所示

enter image description here

将此代码粘贴到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

现在运行您的Userform并单击Command按钮。您会注意到数据被转储到Sheet1中。见快照

enter image description here

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

2）使用Excel的内置工具从网络上获取数据

我相信您使用的是Excel 2007，因此我将以此为例来抓取上述链接。

导航到Sheet2。现在导航到Data Tab并单击按钮＆＃34; From Web＆＃34;在极右翼。见快照。

enter image description here

在＆＃34;新建Web查询窗口中输入网址＆＃34;然后点击＆＃34; Go＆＃34;

上传页面后，单击快照中显示的小箭头，选择要导入的相关表格。完成后，单击＆＃34;导入＆＃34;

enter image description here

然后，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

希望这会有所帮助。如果您仍有疑问，请与我们联系。

西特

答案 1 :(得分：9)

对于对此感兴趣的任何人，我最终根据Siddhart Rout's之前的回答

使用了以下代码
  • XMLHttp明显快于自动IE
  • 代码为每个要下载的系列生成一个CSV文件（保存在X变量中）
  • 代码将每个匹配转储到常规的29行范围（无论有多少玩家参与），以便以后更轻松地进行分析

enter image description here 

    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

答案 2 :(得分：2)

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

您应该使用HtmlAgilityPack来查询HTML。这将允许您使用CSS选择器查询HTML，类似于您使用jQuery执行此操作的方式。

答案 3 :(得分：1)

许多人可能会看到这一点，我想我将以此为契机来演示一些我很少见到的人在VBA网络抓取中使用的功能：deleteRow, querySelector和clipboard的使用根据{{​​1}}将表格（包含格式和超链接）写到表格上。

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

使用CSS选择器和了解table.outerHTML方法/属性将为您的网络抓取工作提供更大的灵活性。了解剪贴板的用法意味着将表转移到Excel的简单复制粘贴方法。

执行可以很容易地与按钮按下和从单元格读取的URL绑定。

VBA：

htmlTable
相关问题
最新问题