Простой способ - захватить все элементы таблицы на странице и зациклить те, которые используют буфер обмена для копирования вставки на лист.Вы можете настроить запись на разные листы в зависимости от значения тикера.Используйте тикеры с циклом для извлечения данных, но убедитесь, что вы создаете объект ie перед циклом, а затем поместите navigate2 в цикле, чтобы посещать каждую новую страницу тикера.
Public Sub GetTables()
Dim clipboard As Object, ws As Worksheet, j As Long, tables As Object
Dim ie As Object, ticker As String
ticker = "FB"
Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Cells.UnMerge
ws.Cells.ClearContents
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Application.ScreenUpdating = False
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate2 "https://finance.yahoo.com/quote/FB/financials?p=" & ticker
While .Busy Or .readyState < 4: DoEvents: Wend
Set tables = .document.querySelectorAll("table")
For j = 0 To tables.Length - 1
clipboard.SetText tables.item(j).outerHTML
clipboard.PutInClipboard
ws.Cells(LastRow(ws) + 2, 1).PasteSpecial
Next
.Quit
End With
Application.ScreenUpdating = True
End Sub
'https://www.rondebruin.nl/win/s9/win005.htm
Public Function LastRow(ByVal sh As Worksheet) As Long
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Этот второй методэто скорее скачок в знаниях для вас, но может быть полезным в будущем и для других читателей.Вы можете извлечь всю информацию на странице из тега скрипта.С помощью некоторого разбиения строки на innerHTML этого элемента скрипта вы можете получить строку, которую может обработать анализатор json.Затем вы можете проанализировать JSON для любой информации, которую вы хотите.Я добавляю схему только ниже.
Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
' Microsoft Scripting Runtime
'Download and add in jsonconverter.bas from https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas
Public Sub GetYahooData()
Dim IE As New InternetExplorer, ticker As String
ticker = "FB"
With IE
.Visible = True
.Navigate2 "https://finance.yahoo.com/quote/FB/financials?p=" & ticker
While .Busy Or .readyState < 4: DoEvents: Wend
Dim script As Object, scripts As Object, i As Long, extract As String, json As Object
Set scripts = .document.querySelectorAll("script")
For i = 0 To scripts.Length - 1
If InStr(1, scripts.item(i).innerHTML, "/* -- Data -- */") Then
Set script = scripts.item(i)
Exit For
End If
Next
If Not script Is Nothing Then
extract = Split(Split(script.innerHTML, "root.App.main = ")(1), "(this));")(0)
extract = Left$(extract, InStrRev(extract, ";") - 1)
Set json = JsonConverter.ParseJson(extract)("context")("dispatcher")("stores")("QuoteSummaryStore")("cashflowStatementHistory")
End If
If Not json Is Nothing Then
'parse json for data of interest
End If
Stop ' <== Delete me later
.Quit
End With
End Sub
В json просто слишком много информации, чтобы пройти через все это, но вот фрагмент снимка веб-страницы слева и json, которыйотносится к нему справа:
