Ниже показан цикл и порядок выбора соответствующей таблицы, затем ячеек таблицы с помощью css селекторов .Тикеры считываются в массив из столбца N, начиная со строки 1. Предполагается, что в диапазоне нет пустых ячеек (хотя можно добавить тест, чтобы быть уверенным).
В массиве есть цикл,который содержит каждый тикер, а заполнитель TICKER в URL-адресе заменяется текущим значением тикера.
На вкладке ежемесячного отображения есть строка, которую нужно щелкнуть.
Соответствующая строка определяется с помощью
Set rankings = .querySelectorAll("#tab-month-end-content .last td")
#tab-month-end-content - селектор идентификатора, который получает правую вкладку, затем .last - селектор класса для имени класса последнего tbody (который last), затем td используется для указания дочерних td ячеек в этом теле.
Селекторы CSS:
Современные браузеры оптимизированы для CSS.Селекторы CSS - это быстрый способ сопоставления элементов в HTML-документе.Селекторы Css применяются с помощью методов querySelector или querySelectorAll;в этом случае HTMLDocument (т.е. документ).querySelector возвращает один узел: первое совпадение для селектора css;querySelectorAll возвращает нодлист из всех совпадающих элементов - затем вы индексируете этот нодлист для получения определенных элементов, например, вторая ячейка td имеет индекс 1.
Глядя на указанный нами шаблон:
#tab-month-end-content .last td
Первая часть - это селектор идентификатора , #, который выбирает элемент по идентификатору
#tab-month-end-content
При применении к странице это возвращает два совпадения, и мы хотим, чтобы вторая
Нажмите на изображение, чтобы увеличить его
Следующая часть
.last
- селектор класса , . для имени класса last.При этом выбирается дочерний элемент тега tbody, показанный на рисунке выше.Так как только у второго элемента, совпадающего с идентификатором, есть этот дочерний элемент, мы теперь работаем с правым родительским элементом, чтобы продолжить и выбрать элементы типа td, используя селектор типа
td
Пробел,
Мы можем увидеть это на следующем изображении:
Нажмите на изображениеувеличить
VBA:
Option Explicit
Public Sub GetData()
Dim ie As Object, tickers(), ws As Worksheet, lastRow As Long
Dim results(), headers(), r As Long, i As Long, url As String
headers = Array("ticker", "3m", "6m", "ytd", "1y", "3y", "6y")
Set ws = ThisWorkbook.Worksheets("Sheet1")
tickers = Application.Transpose(ws.Range("N1:N" & GetLastRow(ws, 14)).Value)
ReDim results(1 To UBound(tickers), 1 To UBound(headers) + 1)
Set ie = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
With ie
.Visible = True
For i = LBound(tickers) To UBound(tickers)
r = r + 1
url = Replace$("http://performance.morningstar.com/fund/performance-return.action?t=TICKER®ion=usa&culture=en_US", "TICKER", tickers(i))
.Navigate2 url
While .Busy Or .readyState < 4: DoEvents: Wend
.document.querySelector("[tabname='#tabmonth']").Click
Dim rankings As Object
Do
Loop While .document.querySelectorAll("#tab-month-end-content .last td").Length = 0 'could add timed loop here
With .document
Set rankings = .querySelectorAll("#tab-month-end-content .last td")
On Error Resume Next
results(r, 1) = tickers(i)
results(r, 2) = rankings.item(1).innerText
results(r, 3) = rankings.item(2).innerText
results(r, 4) = rankings.item(3).innerText
results(r, 5) = rankings.item(4).innerText
results(r, 6) = rankings.item(5).innerText
results(r, 7) = rankings.item(6).innerText
On Error GoTo 0
End With
Set rankings = Nothing
Next
ws.Cells(1, 15).Resize(UBound(results, 1), UBound(results, 2)) = results
.Quit
End With
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
With ws
GetLastRow = .Cells(.rows.Count, columnNumber).End(xlUp).Row
End With
End Function
Как уже упоминалось @SIM, вы можете использовать xmlhttp и избегать браузера, хотя и не уверены в настройках безопасности, нужен ли белый список сайтов.Вам необходимо выяснить, является ли заполнитель действительным в URL здесь: XNAS:TICKER.Префикс XNAS может варьироваться в зависимости от ваших тикеров, и в этом случае вам потребуется соответствующая строка, включая префикс в столбце N, а затем заменить расширенный заполнитель на этот, например ..... =PLACEHOLDER®ion .......
Option Explicit
Public Sub GetData()
Dim tickers(), ws As Worksheet, lastRow As Long
Dim results(), headers(), r As Long, i As Long, url As String, html As HTMLDocument
Set html = New HTMLDocument 'vbe > tools > references > Microsoft HTML Object Library
headers = Array("ticker", "3m", "6m", "ytd", "1y", "3y", "6y")
Set ws = ThisWorkbook.Worksheets("Sheet1")
tickers = Application.Transpose(ws.Range("N1:N" & GetLastRow(ws, 14)).Value)
ReDim results(1 To UBound(tickers), 1 To UBound(headers) + 1)
With CreateObject("MSXML2.XMLHTTP")
For i = LBound(tickers) To UBound(tickers)
r = r + 1
url = Replace$("http://performance.morningstar.com/perform/Performance/fund/trailing-total-returns.action?&t=XNAS:TICKER®ion=usa&culture=en-US&cur=&ops=clear&s=0P0000J533&ndec=2&ep=true&align=m&annlz=true&comparisonRemove=false&loccat=&taxadj=&benchmarkSecId=&benchmarktype=", "TICKER", tickers(i))
.Open "GET", url, False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.setRequestHeader "DNT", "1"
.send
html.body.innerHTML = .responseText
Dim rankings As Object
With html
Set rankings = .querySelectorAll(".last td")
On Error Resume Next
results(r, 1) = tickers(i)
results(r, 2) = rankings.item(1).innerText
results(r, 3) = rankings.item(2).innerText
results(r, 4) = rankings.item(3).innerText
results(r, 5) = rankings.item(4).innerText
results(r, 6) = rankings.item(5).innerText
results(r, 7) = rankings.item(6).innerText
On Error GoTo 0
End With
Set rankings = Nothing
Next
ws.Cells(1, 15).Resize(UBound(results, 1), UBound(results, 2)) = results
End With
End Sub
Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
With ws
GetLastRow = .Cells(.rows.Count, columnNumber).End(xlUp).Row
End With
End Function