我有一段代码,从这个url中抓取一个表。
https:/www.reuters.comcompaniesAAPL.OQfinancialsincome-statement-annual
代码是OK的,除了一点,完全没有问题。代码得到了表,但没有得到表头。
With http
.Open "Get", sURL, False
.send
html.body.innerHTML = .responseText
End With
Set tbl = html.getElementsByTagName("Table")(0)
For Each rw In tbl.Rows
r = r + 1: c = 1
For Each cl In rw.Cells
ws.Cells(r, c).Value = cl.innerText
c = c + 1
Next cl
Next rw
检查URL时,发现API URL支持的是
https:/www.reuters.comcompaniesapigetFetchCompanyFinancialsAAPL.OQ
我如何从JSON响应中提取 "收入 "的 "年度 "数据?
我试图引用我想要的部分,但得到一个错误的信息
Const strUrl As String = "https://www.reuters.com/companies/api/getFetchCompanyFinancials/AAPL.OQ"
Sub Test()
Dim a, json As Object, colData As Collection, sFile As String, i As Long
With CreateObject("MSXML2.ServerXMLHTTP.6.0")
.Open "GET", strUrl
.send
Set json = JSONConverter.ParseJson(.responseText)
End With
Set colData = json("market_data")("financial_statements")
Stop
End Sub
类似于这样的逻辑应该在VBA中工作。
Dim data As Scripting.Dictionary, key As Variant, block As Collection, r As Long, item As Object
Set data = json("market_data")("financial_statements")("financial_statements")("income")("annual") ' dict of collections
r = 1
For Each key In data.keys
Set block = data(key) 'each block (section of info) is a row
r = r + 1: c= 2
For each item In block 'loop columns in block
With Activesheet
If r = 2 then 'write out headers to row 1,starting col2 and then values to row 2 starting from col 2, and key goes in row , col 1
.Cells(1,c) = item("date")
End If
.Cells(r,1) = Key
.Cells(r,c) = item("value")
End With
c = c + 1
Next
Next
我不能在VBA中测试,但如果我写的python(长手)等价物,我得到同样的表。
import requests
import pandas as pd
json = requests.get('https://www.reuters.com/companies/api/getFetchCompanyFinancials/AAPL.OQ').json()
data = json["market_data"]["financial_statements"]["income"]["annual"]
rows = len(data.keys()) + 1
columns = len(data["Revenue"]) + 1
r = 0
df = pd.DataFrame(["" for c in range(columns)] for r in range(rows))
for key in data.keys():
block = data[key]
r+=1 ; c = 1
for item in block:
if r == 1:
df.iloc[0 , c] = item["date"]
df.iloc[r,c] = item["value"]
df.iloc[r,0] = key
c+=1
print(df)
经过这么多时间,我可以这样调整它
Const strUrl As String = "https://www.reuters.com/companies/api/getFetchCompanyFinancials/"
Sub GetData()
Dim ws As Worksheet, sSection As String
For Each ws In ThisWorkbook.Worksheets(Array("IS", "BS", "CF"))
Select Case ws.Name
Case "IS": sSection = "income"
Case "BS": sSection = "balance_sheet"
Case "CF": sSection = "cash_flow"
End Select
GetReuters ws, "tbl" & ws.Name, Sheets("Data").Range("B1").Value, sSection, Sheets("Data").Range("B2").Value
Next ws
End Sub
Sub GetReuters(ByVal ws As Worksheet, ByVal tblName As String, ByVal sTicker As String, ByVal sSection As String, ByVal sTime As String)
Dim a, ky, col As Collection, json As Object, data As Object, dic As Object, rng As Range, i As Long, k As Long, c As Long
With CreateObject("MSXML2.ServerXMLHTTP.6.0")
.Open "GET", strUrl & sTicker
.send
Set json = JSONConverter.ParseJson(.responseText)
End With
ReDim b(1 To 10000, 1 To 7)
c = 1: b(1, c) = "Dates"
Set data = json("market_data")("financial_statements")(sSection)(sTime)
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = 1
For Each ky In data.Keys
Set col = data(ky)
a = CollectionToArray(col)
k = k + 1
b(k + 1, 1) = ky
For i = LBound(a) To UBound(a)
If Not dic.Exists(CStr(a(i, 1))) Then
dic(CStr(a(i, 1))) = c
c = c + 1
b(1, c) = CStr(a(i, 1))
b(k + 1, c) = a(i, 2)
Else
b(k + 1, dic.item(CStr(a(i, 1))) + 1) = a(i, 2)
End If
Next i
Erase a
Next ky
Application.ScreenUpdating = False
With ws
On Error Resume Next
.ListObjects(tblName).Delete
On Error GoTo 0
.Range("A1").Resize(k + 1, UBound(b, 2)).Value = b
With .Range("A1").CurrentRegion
Set rng = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
rng.NumberFormat = "#,##0.00;(#,##0.00)"
rng.Rows(1).Offset(-1).NumberFormat = "dd-mmm-yy"
.Columns.AutoFit
End With
.ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = tblName
End With
Application.ScreenUpdating = True
End Sub
Function CollectionToArray(ByVal c As Collection) As Variant()
Dim a(), i As Long
ReDim a(1 To c.Count, 1 To 2)
For i = 1 To c.Count
a(i, 1) = c.item(i)("date")
a(i, 2) = c.item(i)("value")
Next i
CollectionToArray = a
End Function