Откройте веб-страницу, выберите все, скопируйте на лист
Я искал высоко и низко что-то, что будет работать для меня в этом, не повезло! Любая помощь будет так цениться!:) Глядя, чтобы скопировать данные опционов на акции с Barcharts.com и вставить в лист Excel.
вот где я нахожусь:
Sub CopyTables()
Dim ie As Object
Dim I As Long
I = 0
Set ie = CreateObject("InternetExplorer.Application")
ie.navigate "https://www.barchart.com/stocks/quotes/GOOG/options?moneyness=allRows&view=sbs&expiration=2018-02-23"
ie.Visible = True
Do While ie.Busy And Not ie.readyState = 4
DoEvents
Loop
DoEvents
Set tables = ie.document.getElementsByTagName("table")
SetDataFromWebTable tables, Range("B5")
ie.Quit
End Sub
Если возможно, я бы хотел также извлечь даты из выпадающего списка веб-страниц "Срок действия" и вставить их все в Excel. Заранее большое спасибо за любую помощь в этом!
1 ответ
Источник веб-страницы HTML по предоставленной ссылке
https://www.barchart.com/stocks/quotes/GOOG/options?moneyness=allRows&view=sbs&expiration=2018-02-23
не содержит необходимых данных, он использует AJAX. На веб-сайте https://www.barchart.com/ доступен API. Ответ возвращается в формате JSON. Перейдите на страницу, например, в Chrome, затем откройте окно " Инструменты разработчика" (F12), вкладку " Сеть ", перезагрузите (F5) страницу и изучите зарегистрированные XHR. Наиболее релевантными данными являются строки JSON, возвращаемые URL:
Вы можете использовать приведенный ниже код VBA для получения информации, как описано выше. Импортируйте модуль JSON.bas в проект VBA для обработки JSON.
Option Explicit
Sub Test48759011()
Dim sUrl As String
Dim sJSONString As String
Dim vJSON As Variant
Dim sState As String
Dim aData()
Dim aHeader()
sUrl = "https://core-api.barchart.com/v1/options/chain?" & _
Join(Array( _
"symbol=GOOG", _
"fields=" & _
Join(Array( _
"optionType", _
"strikePrice", _
"lastPrice", _
"percentChange", _
"bidPrice", _
"askPrice", _
"volume", _
"openInterest"), _
"%2C"), _
"groupBy=", _
"meta=" & _
Join(Array( _
"field.shortName", _
"field.description", _
"field.type"), _
"%2C"), _
"raw=1", _
"expirationDate=2018-02-23"), _
"&")
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", sUrl, False
.send
sJSONString = .responseText
End With
JSON.Parse sJSONString, vJSON, sState
vJSON = vJSON("data")
JSON.ToArray vJSON, aData, aHeader
With Sheets(1)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "@"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "@"
.Value = aCells
End With
End With
End Sub
Вывод для меня выглядит следующим образом:
Чтобы сделать вывод ближе к параллельному виду на веб-странице, вы можете немного поиграть с параметрами запроса:
sUrl = "https://core-api.barchart.com/v1/options/chain?" & _
Join(Array( _
"symbol=GOOG", _
"fields=" & _
Join(Array( _
"optionType", _
"strikePrice", _
"lastPrice", _
"percentChange", _
"bidPrice", _
"askPrice", _
"volume", _
"openInterest"), _
"%2C"), _
"groupBy=strikePrice", _
"meta=", _
"raw=0", _
"expirationDate=2018-02-23"), _
"&")
А также изменить линию
Set vJSON = vJSON("data")
В этом случае вывод будет следующим:
Кстати, аналогичный подход применяется в следующих ответах: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 и 11.