Как выбрать n-е вхождение в исходном коде сети - PullRequest
Новая
       40

Как выбрать n-е вхождение в исходном коде сети

0 голосов
/ 31 августа 2018

Я пытаюсь найти 52-недельный ценовой диапазон через Yahoo Finance для списка тикеров.

URL: 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

1 Ответ

0 голосов
/ 31 августа 2018

На мой взгляд, это странный метод анализа HTML и неэффективный.

Хороший путь:

Если вы находитесь за пределами диапазона, вы можете использовать метод querySelector, равный HTMLDocument, если вы храните ответ в переменной 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

Элемент, о котором идет речь:

test

Менее желательный способ:

Менее желательным методом было бы использование Split, чтобы вырезать то, что вы хотите, например, 

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
...