为什么在网站被重写后，我的解析程序给了我奇怪的结果

问：

我有一个解析站点的程序（需要一个表）。该程序运行良好，但是在重写网站后，它停止产生所需的结果。

以前

后

法典：

Sub Softочки()
Application.DisplayAlerts = False
Call mainмассивы
Application.DisplayAlerts = True
End Sub


Sub mainмассивы()
Dim r As Range
Dim iLoop As Long
Dim book1 As Workbook
Dim Ssilka As String
Dim A As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Set book1 = Workbooks.Open("D:\Super M\Поиск решения\Усов 9\Разработка\Шапка для болванки ФИН ПРОГИ\таблица.xlsm")
 

 
    With book1.Worksheets("таблица").Range("B34:B53")
       iLoop = 0
         For Each r In .Rows
          
        
              iLoop = iLoop + 1
              Ssilka = r.Hyperlinks.Item(1).Address
              book1.Worksheets("Лист" & iLoop).Activate
              extractTable Ssilka, book1, iLoop
          
        Next r
    End With

 book1.Save
 book1.Close

 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True

 End Sub


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, "<SCRIPT language=JavaScript><!--"))

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")(0)

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.club/league.php")
            vata(x, y) = oRow.Cells(y).innerText
            
        End If

    Next y
Next x

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


Set odRange = book1.ActiveSheet.Cells(34, 2).Resize(iRows - 1, iCols - 1)
odRange.NumberFormat = "@"
odRange.Value = vata


Set odRange = Nothing


End Function

本站链接：https://allscores.club/league.php?sport=soccer&champ=4804&f_team=412&new_tid=0

首先，程序给了我一个错误。比我在代码中更改了表的编号。程序有效，但不正确。