Как получить результаты для очистки веб-страниц для разных ячеек с разными URL?

Question

Я настраиваю электронную таблицу, которая будет ежедневно получать NAV для конкретных индексных фондов с веб-сайта blackrock. Однако существует ряд таких индексных фондов, и URL-адрес изменяется для каждой ячейки. Я не уверен, как пройтись по моей таблице и поместить целевое значение в другую ячейку.

Я пытался перечислять все возможные URL один за другим, и, похоже, это работает, однако я продолжаю получать сообщение об ошибке времени выполнения, поэтому должен предположить, что есть более эффективный способ сделать это.

Sub GetCurrentPrices()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim text As String

    With CreateObject("internetexplorer.application")
        .navigate "https://www.blackrock.com/uk/individual/products/xxxxxx/"
        Do While .Busy And .readyState <> 4: DoEvents: Loop
        text = .document.getElementsByClassName("header-nav-data")(0).innerText
        .Quit
    End With

    ws.Cells(32, 1).Value = text

    With CreateObject("internetexplorer.application")
        .navigate "https://www.blackrock.com/uk/individual/products/yyyyyy/"
        Do While .Busy And .readyState <> 4: DoEvents: Loop
        text = .document.getElementsByClassName("header-nav-data")(0).innerText
        .Quit
    End With

    ws.Cells(33, 1).Value = text

End Sub

В настоящее время этот код копируется примерно 22 раза для каждого отдельного URL. Я также попробовал что-то вроде этого:

Sub GetCurrentPrices2()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim text As String
    Dim i As Integer
    i=32

    With CreateObject("internetexplorer.application")
        .navigate "https://www.blackrock.com/uk/individual/products/" & (ws.Range("H2:H24").Value) & "/"
        Do While .Busy And .readyState <> 4: DoEvents: Loop
        text = .document.getElementsByClassName("header-nav-data")(0).innerText
        .Quit
    End With

    Do Until i > 46
        ws.Cells(i,1).Value = text
    Loop

End Sub

Answer 1

Если предположить, что столбец A содержит индексный фонд интересов, а данные начинаются со строки 2, ваш код можно переписать следующим образом ...

Sub GetCurrentPrices()

    Dim ws As Worksheet
    Dim text As String
    Dim lastRow As Long
    Dim i As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    With ws
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    With CreateObject("InternetExplorer.Application")
        For i = 2 To lastRow
            .navigate "https://www.blackrock.com/uk/individual/products/" & ws.Cells(i, 1).Value & "/"
            Do While .Busy And .readyState <> 4: DoEvents: Loop
            text = .document.getElementsByClassName("header-nav-data")(0).innerText
            ws.Cells(i, 2).Value = text
        Next i
        .Quit
    End With

    Set ws = Nothing

End Sub