如何在 Web 源代码中选择第 n 次出现

Question

我正在尝试通过 Yahoo Finance 查找 52 周价格范围以获取代码列表。

网址：https://finance.yahoo.com/quote/AAPL?p=AAPL

我查看了在线和 youtube，并从那里使用了很多指导。但是，当我运行代码时，它会选择数组的第一个实例，而实际上我需要第 6 个。因为该页面似乎也由许多其他代码组成，所以我需要的不是第一个，根据我正在搜索的字符串 - “fiftyTwoWeekRange”。

有没有办法可以指定搜索不是第一次而是第n次出现？谢谢你的帮助。我在 YouTube 上找到的代码非常有用，但我希望你们能帮忙解决这个问题。

Sub qTest_3()

    Call clear_data

    Dim myrng As Range
    Dim lastrow As Long
    Dim row_count As Long
    Dim ws As Worksheet
    Set ws = Sheets("Main2")

    col_count = 2
    row_count = 2

    'Find last row
    With ws
        lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    End With

    'set ticker range
    Set myrng = ws.Range(Cells(2, 1), Cells(lastrow, 1))

    'llop through tickers
    For Each ticker In myrng

        'Send web request
        Dim URL2 As String: URL2 = "https://finance.yahoo.com/quote/" & ticker & "?p=" & ticker & ""
        Dim Http2 As New WinHttpRequest

        Http2.Open "GET", URL2, False
        Http2.Send

        Dim s As String
        'Get source code of site
        s = Http2.ResponseText

        Dim metrics As Variant
        '**** Metric fields here
        metrics = Array("fiftyTwoWeekRange")


        'Split string here
        For Each element In metrics

            firstTerm = Chr(34) & element & Chr(34) & ":{" & Chr(34) & "raw" & Chr(34) & ":"
            secondTerm = "," & Chr(34) & "fmt" & Chr(34)

            nextPosition = 1

            On Error GoTo err_hdl

            Do Until nextPosition = 0
                startPos = InStr(nextPosition, s, firstTerm, vbTextCompare)
                stopPos = InStr(startPos, s, secondTerm, vbTextCompare)
                split_string = Mid$(s, startPos + Len(firstTerm), stopPos - startPos - Len(secondTerm))
                nextPosition = InStr(stopPos, s, firstTerm, vbTextCompare)

                Exit Do
            Loop

            On Error GoTo 0

            Dim arr() As String
            arr = Split(split_string, ",")
            metric = arr(0)

            'Output to sheet
            ws.Range(Cells(row_count, col_count), Cells(row_count, col_count)).Value = metric
            col_count = col_count + 1

getData:

        Next element

        Dim symbol As String
        symbol = ticker

        col_count = 2
        row_count = row_count + 1

    Next ticker

    MsgBox ("Done")

    Exit Sub

err_hdl:
    ws.Range(Cells(row_count, col_count), Cells(row_count, col_count)).Value = "N/A"
    Resume getData

End Sub
Sub clear_data()

    Dim ws As Worksheet
    Set ws = Sheets("Main2")
    Dim lastrow, lastcol As Long
    Dim myrng As Range

    With ws
     lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
    End With

    lastcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    Set myrng = ws.Range(Cells(2, 2), Cells(lastrow, lastcol))

    myrng.Clear

End Sub

Answer 1

在我看来，这是一种奇怪的 HTML 解析方法，而且效率低下。

好办法：

如果您在范围之后，您可以使用HTMLDocument 的querySelector 方法，如果您将响应存储在HTMLDocument 变量中。例如，我会研究 CSS 选择器，作为获取您感兴趣的数据的更好方法。

Option Explicit
Public Sub test()
    Dim html As HTMLDocument
    Set html = New HTMLDocument
    With CreateObject("WINHTTP.WinHTTPRequest.5.1")
        .Open "GET", "https://finance.yahoo.com/quote/AAPL?p=AAPL", False
        .send
        html.body.innerHTML = .responseText
    End With

    Debug.Print html.querySelector("[data-test=FIFTY_TWO_WK_RANGE-value]").innertext
End Sub

这使用 CSS 选择器通过其属性来定位元素。 [] 表示属性选择器。它与属性为data-test 的元素匹配，其值为FIFTY_TWO_WK_RANGE-value

---

有问题的元素：

---

不太理想的方式：

一个不太理想的方法是使用拆分来删除你所追求的，例如

Debug.Print Split(Split(Split(Http2.ResponseText, "data-test=""FIFTY_TWO_WK_RANGE-value""")(1), "<")(0), ">")(1)

---

一个可能更适合您的代码的版本如下（通常我会将范围放入一个数组并循环更快，但这更接近您的）：

Option Explicit
Public Sub test()
    Dim html As HTMLDocument, http As Object, ticker As Range
    Set html = New HTMLDocument
    Set http = CreateObject("WINHTTP.WinHTTPRequest.5.1")

    Dim lastRow As Long, myrng As Range
    With ThisWorkbook.Worksheets("Main2")

        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set myrng = .Range("A2:A" & lastRow)

        For Each ticker In myrng
            If Not IsEmpty(ticker) Then
                With http
                    .Open "GET", "https://finance.yahoo.com/quote/" & ticker.Value & "?p=" & ticker.Value, False
                    .send
                    html.body.innerHTML = .responseText
                End With
                On Error Resume Next
                ticker.Offset(, 1) = html.querySelector("[data-test=FIFTY_TWO_WK_RANGE-value]").innertext
               'ticker.Offset(, 1) = Split(Split(Split(http.ResponseText, "data-test=""FIFTY_TWO_WK_RANGE-value""")(1), "<")(0), ">")(1)  ''<<Or this version 
                On Error GoTo 0
            End If
        Next
    End With
End Sub