使用 VBA 查找要在 Excel 电子表格上打印的网页元素

Question

Edit1：我的问题的解决方案可以在下面的 cmets 中找到，关于 Zwenn

在 excel 中打印时，我需要帮助来查找要在说明中使用的正确网站元素。以下是我在打印页面的前半部分时有效的内容，但不是第二部分。我无法使用下面的导航打印网页上的“全季课程统计”表格，我希望能够使用不同的元素导航来打印。

在网页上查找“all seasons course statistics”表格时，表格元素在检查网页时超过了“tabs-wrapper rns-scroll”类元素。

相关网站：https://www.racingandsports.com/thoroughbred/jockey/jake-bayliss/27461。

VBA代码的第一部分：

Sub Horse2()

Dim IE As InternetExplorer
Application.ScreenUpdating = False

Set IE = New InternetExplorer
IE.Visible = True

Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim http As New XMLHTTP60, html As New HTMLDocument

Dim node As HTMLHtmlElement
Dim nodeTr As HTMLHtmlElement
Dim nodeDiv As HTMLHtmlElement
Dim Element1 As HTMLHtmlElement
Dim node1 As HTMLHtmlElement
Dim currentUrl As String
  
    With http
        .Open "GET", "https://www.racingandsports.com/thoroughbred/jockey/jake-bayliss/27461", False
        .send
        html.body.innerHTML = .responseText
    End With

元素导航在 VBA 中从这里开始。这里的元素只是浏览其他表格而不是我需要的表格，我不知道如何让它进入“所有季节课程统计”表格，即使它包含相同的元素名称。

With html.getElementsByClassName("col-md-12 table-responsive")
For Each node In html.getElementsByClassName("table rns-table")
    r = r + 1: c = 4
    For Each nodeTr In node.getElementsByTagName("tr")
        With nodeTr.getElementsByTagName("td")
            If .Length Then

            ws.Cells(r + 1, c + 3) = .Item(0).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 4) = .Item(1).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 5) = .Item(2).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 6) = .Item(3).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 7) = .Item(4).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 8) = .Item(5).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 9) = .Item(6).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 10) = .Item(7).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 11) = .Item(8).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 12) = .Item(9).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 13) = .Item(10).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 14) = .Item(11).innerText
            On Error Resume Next
            ws.Cells(r + 1, c + 15) = .Item(12).innerText
            On Error Resume Next
            
            r = r + 1
            End If
        End With
    Next
Next
End With

    IE.Quit
    Set IE = Nothing
    Application.StatusBar = ""
    Application.ScreenUpdating = True

    MsgBox "data input complete"

End Sub

Answer 1

除了我上面的评论，这里是代码优化的建议。正如我所说，On Error Resume Next 在大多数情况下不是一个好的选择。您可以通过只接管循环中存在的尽可能多的元素来避免在此处使用它。此外，您应该使您的行和列处理不那么复杂。这些只是需要管理的数字。这通常可以通过 +1 并重置列来完成。不需要其他更正。

以下代码输出与您的初始宏完全相同：

Sub Horse2()

Dim ws As Worksheet
Dim r As Long
Dim c As Long
Dim http As New XMLHTTP60
Dim html As New HTMLDocument
Dim node As HTMLHtmlElement
Dim nodeTr As HTMLHtmlElement
Dim oneElement As Long

  Set ws = ThisWorkbook.Worksheets("Sheet1")
  r = 2
  c = 7
  
  With http
    .Open "GET", "https://www.racingandsports.com/thoroughbred/jockey/jake-bayliss/27461", False
    .send
    html.body.innerHTML = .responseText
  End With
  
  With html.getElementsByClassName("col-md-12 table-responsive")
    For Each node In html.getElementsByClassName("table rns-table")
      For Each nodeTr In node.getElementsByTagName("tr")
        With nodeTr.getElementsByTagName("td")
          If .Length Then
            For oneElement = 0 To .Length - 1
              ws.Cells(r, c) = .Item(oneElement).innerText
              c = c + 1
            Next oneElement
            c = 7
            r = r + 1
          End If
        End With
      Next
      r = r + 1
    Next
  End With
  
  MsgBox "Data input complete"
End Sub