修改程序以进行解析

Question

有一个程序可以解析网站上的某个表格。效果很好。我想从网站解析另一个表。通过标签号“表”它们是相同的。我试图使用相同的程序，但它给出了一个错误：行中的运行时错误91：

     If oRow.Cells(y).Children.Length > 0 Then

新表：http://allscores.ru/soccer/fstats.php?champ=2604&team=439&team2=420&tour=110

旧表：http://allscores.ru/soccer/new_ftour.php?champ=2604&f_team=439

新表：在附图中

Function extractTable(Ssilka As String, book1 As Workbook, iLoop As Long)
    Dim oDom As Object, oTable As Object, oRow As Object
    Dim iRows As Integer, iCols As Integer
    Dim x As Integer, y As Integer
    Dim data()
    Dim vata()
    Dim tata()
    Dim oHttp As Object
    Dim oRegEx As Object
    Dim sResponse As String
    Dim oRange As Range
    Dim odRange As Range

   ' get page
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    oHttp.Open "GET", Ssilka, False
    oHttp.Send

    ' cleanup response
    sResponse = StrConv(oHttp.responseBody, vbUnicode)
    Set oHttp = Nothing

    sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))

    Set oRegEx = CreateObject("vbscript.regexp")
    With oRegEx
        .MultiLine = True
        .Global = True
        .IgnoreCase = False
        .Pattern = "<(script|SCRIPT)[\w\W]+?</\1>"
        sResponse = .Replace(sResponse, "")
    End With
    Set oRegEx = Nothing

    ' create Document from response
    Set oDom = CreateObject("htmlFile")
    oDom.Write sResponse
    DoEvents

    ' table with results, indexes starts with zero
    Set oTable = oDom.getelementsbytagname("table")(3)

    DoEvents

    iRows = oTable.Rows.Length
    iCols = oTable.Rows(1).Cells.Length

    ' first row and first column contain no intresting data
    ReDim data(1 To iRows - 1, 1 To iCols - 1)
    ReDim vata(1 To iRows - 1, 1 To iCols - 1)
    ReDim tata(1 To iRows - 1, 1 To iCols - 1)
    ' fill in data array
    For x = 1 To iRows - 1
        Set oRow = oTable.Rows(x)
        For y = 1 To iCols - 1
            If oRow.Cells(y).Children.Length > 0 Then
                data(x, y) = oRow.Cells(y).getelementsbytagname("a")(0).getattribute("href")
                data(x, y) = Replace(data(x, y), "about:", "http://allscores.ru/soccer/")
                vata(x, y) = oRow.Cells(y).innerText
            End If
        Next y
    Next x

    Set oRow = Nothing
    Set oTable = Nothing
    Set oDom = Nothing

    Set oRange = book1.ActiveSheet.Cells(110, 26 + (iLoop * 21)).Resize(iRows - 1, iCols - 1)
    oRange.NumberFormat = "@"
    oRange.Value = data

    Set odRange = book1.ActiveSheet.Cells(34, 26 + (iLoop * 21)).Resize(iRows - 1, iCols - 1)
    odRange.NumberFormat = "@"
    odRange.Value = vata

    Set oRange = Nothing
    Set odRange = Nothing

End Function

Answer 1

这不是特别强大但是从表中获取值。 <{1}}未使用。

iLoop