cricinfo记分卡的html解析_Html_Regex_Excel_Xml_Vba

cricinfo记分卡的html解析

html regex excel xml vba

cricinfo记分卡的html解析,html,regex,excel,xml,vba,Html,Regex,Excel,Xml,Vba,目标我希望从中提取20/20板球记分卡数据，理想情况下将其转换为CSV格式，以便在Excel中进行数据分析例如，当前的澳大利亚Big Bash 2011/12记分卡可从游戏1：最后一场比赛：背景我精通使用VBA（自动化IE或使用XMLHTTP然后使用正则表达式）从网站上抓取数据，即在同一个问题中，有人发表了一条评论，建议进行html解析——这是我以前从未遇到过的问题——因此我研究了以下问题：查询虽然我可以编写一个正则表达式来解析下面的cricket数据，但我想知道如何通过

目标

我希望从中提取20/20板球记分卡数据，理想情况下将其转换为CSV格式，以便在Excel中进行数据分析

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

游戏1：
最后一场比赛：

背景

我精通使用VBA（自动化

IE

或使用

XMLHTTP

然后使用正则表达式）从网站上抓取数据，即

在同一个问题中，有人发表了一条评论，建议进行html解析——这是我以前从未遇到过的问题——因此我研究了以下问题：

查询

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

请记住，我的首选是可重复的CSV格式，包含：

比赛的日期/名称
第一队的名字
输出应为第1队转储多达11条记录（球员未击球的空白记录，即“未击球”）
第2队姓名
输出最多应为第2队转储11条记录（球员未击球的空白记录）

对于我来说，Nirvana是一个可以使用VBA或VBscript部署的解决方案，这样我就可以完全自动化我的分析，但我想我必须使用一个单独的工具来进行html解析

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

正则表达式不是解析HTML的完整解决方案，因为它不能保证是常规的

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

有两种技术可用于“VBA”。我将逐一描述它们

1）使用FireFox/Firebug插件/Fiddler

2）使用Excel的内置工具从web获取数据

因为这篇文章会被很多人阅读，所以我甚至会涵盖显而易见的内容。请随意跳过你知道的任何部分

1）使用FireFox/Firebug插件/Fiddler

火狐：免费下载（）

Firebug插件：免费下载（）

小提琴手：免费下载（）

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

另一个例子是在一个网站上查找一个表的名称，其中包含您需要废弃的数据

我只有在使用XMLHTTP时才使用Fiddler。当你点击一个按钮时，它可以帮助我看到传递的确切信息。由于抓取站点的机器人数量增加，现在大多数站点为了防止自动抓取，捕获鼠标坐标并传递该信息，而fiddler实际上帮助您调试正在传递的信息。我不会在这里谈论太多细节，因为这些信息可能被恶意使用

现在让我们举一个简单的例子来说明如何在你的问题

中搜索URL。

首先，让我们找到包含该信息的表的名称。只需在表上单击鼠标右键，然后单击“使用Firebug检查元素”，它将为您提供下面的快照

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

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

启动VBA并插入用户表单。放置命令按钮和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

希望这有帮助。如果您还有疑问，请告诉我

Sid

对于其他对此感兴趣的人，我根据前面的答案使用了下面的代码

```
XMLHttp
```
比自动化
```
IE
```
代码为要加载的每个系列生成一个CSV文件（保存在
```
X
```
变量中）
该代码将每场比赛转储到常规的29排范围（不管有多少球员击球），以便以后更容易地进行分析

公共子填充数据表\u XML（）
将URL设置为字符串
将ws设置为工作表
长得一样长
暗淡的阴影和长的一样
模糊的印像长的一样
暗淡的lngSpare尽可能长
朦胧的记忆如同漫长
暗淡的lngRow1一样长
尺寸X（1到15，1到4）作为字符串
作为对象的Dim objFSO
作为对象的Dim objTF
Dim xmlHttp作为对象
将htmldoc设置为HTMLDocument
将htmlbody变暗为htmlbody
将tbl设置为HTMLTable
Dim tr为HTMLTableRow
像细绳一样模糊的条纹
s=计时器（）
设置xmlHttp=CreateObject（“MSXML2.ServerXMLHTTP”）
设置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）=“印度超级联赛-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）=“大巴什联盟-2011”
X（3，1）=“http://www.espncricinfo.com/ausdomestic-2010/engine/match/"
X（3，2）=461028
X（3，3）=461047
X（3，4）=“大巴什联盟-2010”
设置htmldoc=新的HTMLDocument
设置htmlbody=htmldoc.body
对于lngRow=1到UBound（X，1）
如果Len（X（lngRow，1））=0，则退出
设置objTF=objFSO.createtextfile（“c:\temp\”&X（lngRow，4）&
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

    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

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