Excel VBA 网页源代码-如何将多个字段提取为一个sheet
Excel VBA web source code - how to extract multiple fields to one sheet
大家下午好。在对 QHarr 非常解决的先前查询的跟进中,我想 运行 针对源代码中的多个字段而不是一个字段解决查询。
我用的URL是:https://finance.yahoo.com/quote/AAPL/?p=AAPL
和采用 'Previous Close'
价格的 VBA 代码是:
Option Explicit
Sub PreviousClose()
Dim html As HTMLDocument, http As Object, ticker As Range
Set html = New HTMLDocument
Set http = CreateObject("WINHTTP.WinHTTPRequest.5.1")
Dim lastRow As Long, myrng As Range
With ThisWorkbook.Worksheets("Tickers")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myrng = .Range("A2:A" & lastRow)
For Each ticker In myrng
If Not IsEmpty(ticker) Then
With http
.Open "GET", "https://finance.yahoo.com/quote/" & ticker.Value & "?p=" & ticker.Value, False
.send
html.body.innerHTML = .responseText
End With
On Error Resume Next
ticker.Offset(, 1) = html.querySelector("[data-test=PREV_CLOSE-value]").innertext
On Error GoTo 0
End If
Next
End With
End Sub
无论如何,理想情况下,每个字段都位于用于股票的行情代码右侧的一行中。
Sheet的截图:
非常感谢任何帮助。
谢谢。
tl;dr;
下面的代码适用于给定的测试用例。如果列表更长,请参阅 ToDo
部分。
API:
如果可能,您想查看 API 以提供此信息。我相信Alpha Vantage now provide info the Yahoo Finance API used to* . There is a nice JS tutorial here. Alpha Vantage documentation here。在这个答案的最底部,我快速浏览了 API 提供的时间序列函数。
WEBSERVICE 函数:
使用 API 键,您还可以潜在地使用 Excel 中的网络服务功能来检索和解析数据。示例 here。 未测试。
XMLHTTPRequest 和 class:
但是,我将向您展示一种使用 class 和 URL 循环的方法。您可以对此进行改进。我使用名为 clsHTTP
的基本框架 class 来保存 XMLHTTP 请求 object。我给它2种方法。一个 GetHTMLDoc
到 return html 文档中的请求响应,另一个 GetInfo
到 return 感兴趣的项目数组页面。
以这种方式使用 class 意味着我们节省了重复创建和销毁 xmlhttp object 的开销,并提供了一组很好的描述性公开方法来处理所需的任务。
假定您的数据如图所示,header 行是第 2 行。
待办事项:
最明显的发展,IMO,你会想要添加一些错误处理。例如,你可能想要开发 class 来处理服务器错误。
VBA:
因此,在您的项目中添加一个名为 clsHTTP
的 class 模块并放置以下内容:
clsHTTP
Option Explicit
Private http As Object
Private Sub Class_Initialize()
Set http = CreateObject("MSXML2.XMLHTTP")
End Sub
Public Function GetHTMLDoc(ByVal URL As String) As HTMLDocument
Dim html As HTMLDocument
Set html = New HTMLDocument
With http
.Open "GET", URL, False
.send
html.body.innerHTML = StrConv(.responseBody, vbUnicode)
Set GetHTMLDoc = html
End With
End Function
Public Function GetInfo(ByVal html As HTMLDocument, ByVal endPoint As Long) As Variant
Dim nodeList As Object, i As Long, result(), counter As Long
Set nodeList = html.querySelectorAll("tbody td")
ReDim result(0 To endPoint - 1)
For i = 1 To 2 * endPoint Step 2
result(counter) = nodeList.item(i).innerText
counter = counter + 1
Next
GetInfo = result
End Function
在标准模块中(模块 1)
Option Explicit
Public Sub GetYahooInfo()
Dim tickers(), ticker As Long, lastRow As Long, headers()
Dim wsSource As Worksheet, http As clsHTTP, html As HTMLDocument
Application.ScreenUpdating = False
Set wsSource = ThisWorkbook.Worksheets("Sheet1") '<== Change as appropriate to sheet containing the tickers
Set http = New clsHTTP
headers = Array("Ticker", "Previous Close", "Open", "Bid", "Ask", "Day's Range", "52 Week Range", "Volume", "Avg. Volume", "Market Cap", "Beta", "PE Ratio (TTM)", "EPS (TTM)", _
"Earnings Date", "Forward Dividend & Yield", "Ex-Dividend Date", "1y Target Est")
With wsSource
lastRow = GetLastRow(wsSource, 1)
Select Case lastRow
Case Is < 3
Exit Sub
Case 3
ReDim tickers(1, 1): tickers(1, 1) = .Range("A3").Value
Case Is > 3
tickers = .Range("A3:A" & lastRow).Value
End Select
ReDim results(0 To UBound(tickers, 1) - 1)
Dim i As Long, endPoint As Long
endPoint = UBound(headers)
For ticker = LBound(tickers, 1) To UBound(tickers, 1)
If Not IsEmpty(tickers(ticker, 1)) Then
Set html = http.GetHTMLDoc("https://finance.yahoo.com/quote/" & tickers(ticker, 1) & "/?p=" & tickers(ticker, 1))
results(ticker - 1) = http.GetInfo(html, endPoint)
Set html = Nothing
Else
results(ticker) = vbNullString
End If
Next
.Cells(2, 1).Resize(1, UBound(headers) + 1) = headers
For i = LBound(results) To UBound(results)
.Cells(3 + i, 2).Resize(1, endPoint-1) = results(i)
Next
End With
Application.ScreenUpdating = True
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
结果:
关于 GetInfo
方法和 CSS 选择器的注释:
GetInfo
的 class 方法使用 css 组合选择器从每个网页中提取信息以定位页面样式。
我们在每个页面上查找的信息是两个相邻 table 中的房子,例如:
与其乱搞多个 table,我只是将所有 table 单元格作为目标,在 table body 元素中,选择器组合为 tbody td
.
CSS 选择器组合通过 HTMLDocument
的 querySelectorAll
方法应用,return 静态 nodeList
.
returned nodeList
项在偶数索引处有 headers,在奇数索引处有所需的数据。我只想要前两个 tables 的信息,所以我终止了 returned nodeList
的循环,当我给出了感兴趣的 headers 长度的两倍时。我使用索引 1 中的第 2 步循环仅检索感兴趣的数据,减去 headers.
returned nodeList
的样例:
参考资料(VBE > 工具 > 参考资料):
- 微软HTMLObject库
阿尔法优势 API:
快速查看 time series API
调用表明可以使用字符串
https://www.alphavantage.co/query?function=TIME_SERIES_DAILY&symbol=AA&outputsize=full&apikey=yourAPIKey
这会产生一个 JSON 响应,在整个 returned 字典的 Time Series (Daily)
子字典中,有 199 个日期 returned。每个日期都有以下信息:
稍微深入研究文档将揭示是否可以捆绑代码,我无法快速看到这一点,以及是否可以通过不同的查询字符串获得更多您最初感兴趣的项目。
还有更多信息,例如,在 URL 调用中使用 TIME_SERIES_DAILY_ADJUSTED
函数
https://www.alphavantage.co/query?function=TIME_SERIES_DAILY_ADJUSTED&symbol=AA&outputsize=full&apikey=yourAPIkey
在这里,您将得到以下内容:
您可以使用 JSON 解析器(例如 JSONConverter.bas)解析 JSON 响应,并且还有用于 csv 下载的选项。
* 值得研究一下哪些 API 提供了最多的项目覆盖率。 Alpha Vantage 似乎没有覆盖我上面的代码检索到的那么多。
这是一些漂亮的代码!!我很喜欢!!顺便说一句,您可能想考虑使用 R 来做这种事情。看看你可以用几行简单的代码做些什么!
library(finreportr)
# print available functions in finreportr
ls('package:finreportr')
my.ticker <- 'SBUX'
# set final year
my.year <- 2017
# get income for FB
my.income <- GetIncome(my.ticker, my.year)
# print result
print(head(my.income))
# get unique fields
unique.fields <- unique(my.income$Metric)
# cut size of string
unique.fields <- substr(unique.fields,1, 60)
# print result
print(unique.fields)
# set col and date
my.col <- 'Earnings Per Share, Basic'
# print earnings per share
print(my.income[my.income$Metric == my.col, ])
library(tidyquant)
# set stock and dates
my.ticker <- 'AAPL'
first.date <- '2017-01-01'
last.date <- Sys.Date()
# get data with tq_get
my.df <- tq_get(my.ticker,
get = "stock.prices",
from = first.date,
to = last.date)
print(tail(my.df))
# get key financial rations of AAPL
df.key.ratios <- tq_get("AAPL",get = "key.ratios")
# print it
print(df.key.ratios)
大家下午好。在对 QHarr 非常解决的先前查询的跟进中,我想 运行 针对源代码中的多个字段而不是一个字段解决查询。
我用的URL是:https://finance.yahoo.com/quote/AAPL/?p=AAPL
和采用 'Previous Close'
价格的 VBA 代码是:
Option Explicit
Sub PreviousClose()
Dim html As HTMLDocument, http As Object, ticker As Range
Set html = New HTMLDocument
Set http = CreateObject("WINHTTP.WinHTTPRequest.5.1")
Dim lastRow As Long, myrng As Range
With ThisWorkbook.Worksheets("Tickers")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myrng = .Range("A2:A" & lastRow)
For Each ticker In myrng
If Not IsEmpty(ticker) Then
With http
.Open "GET", "https://finance.yahoo.com/quote/" & ticker.Value & "?p=" & ticker.Value, False
.send
html.body.innerHTML = .responseText
End With
On Error Resume Next
ticker.Offset(, 1) = html.querySelector("[data-test=PREV_CLOSE-value]").innertext
On Error GoTo 0
End If
Next
End With
End Sub
无论如何,理想情况下,每个字段都位于用于股票的行情代码右侧的一行中。
Sheet的截图:
非常感谢任何帮助。
谢谢。
tl;dr;
下面的代码适用于给定的测试用例。如果列表更长,请参阅 ToDo
部分。
API:
如果可能,您想查看 API 以提供此信息。我相信Alpha Vantage now provide info the Yahoo Finance API used to* . There is a nice JS tutorial here. Alpha Vantage documentation here。在这个答案的最底部,我快速浏览了 API 提供的时间序列函数。
WEBSERVICE 函数:
使用 API 键,您还可以潜在地使用 Excel 中的网络服务功能来检索和解析数据。示例 here。 未测试。
XMLHTTPRequest 和 class:
但是,我将向您展示一种使用 class 和 URL 循环的方法。您可以对此进行改进。我使用名为 clsHTTP
的基本框架 class 来保存 XMLHTTP 请求 object。我给它2种方法。一个 GetHTMLDoc
到 return html 文档中的请求响应,另一个 GetInfo
到 return 感兴趣的项目数组页面。
以这种方式使用 class 意味着我们节省了重复创建和销毁 xmlhttp object 的开销,并提供了一组很好的描述性公开方法来处理所需的任务。
假定您的数据如图所示,header 行是第 2 行。
待办事项:
最明显的发展,IMO,你会想要添加一些错误处理。例如,你可能想要开发 class 来处理服务器错误。
VBA:
因此,在您的项目中添加一个名为 clsHTTP
的 class 模块并放置以下内容:
clsHTTP
Option Explicit
Private http As Object
Private Sub Class_Initialize()
Set http = CreateObject("MSXML2.XMLHTTP")
End Sub
Public Function GetHTMLDoc(ByVal URL As String) As HTMLDocument
Dim html As HTMLDocument
Set html = New HTMLDocument
With http
.Open "GET", URL, False
.send
html.body.innerHTML = StrConv(.responseBody, vbUnicode)
Set GetHTMLDoc = html
End With
End Function
Public Function GetInfo(ByVal html As HTMLDocument, ByVal endPoint As Long) As Variant
Dim nodeList As Object, i As Long, result(), counter As Long
Set nodeList = html.querySelectorAll("tbody td")
ReDim result(0 To endPoint - 1)
For i = 1 To 2 * endPoint Step 2
result(counter) = nodeList.item(i).innerText
counter = counter + 1
Next
GetInfo = result
End Function
在标准模块中(模块 1)
Option Explicit
Public Sub GetYahooInfo()
Dim tickers(), ticker As Long, lastRow As Long, headers()
Dim wsSource As Worksheet, http As clsHTTP, html As HTMLDocument
Application.ScreenUpdating = False
Set wsSource = ThisWorkbook.Worksheets("Sheet1") '<== Change as appropriate to sheet containing the tickers
Set http = New clsHTTP
headers = Array("Ticker", "Previous Close", "Open", "Bid", "Ask", "Day's Range", "52 Week Range", "Volume", "Avg. Volume", "Market Cap", "Beta", "PE Ratio (TTM)", "EPS (TTM)", _
"Earnings Date", "Forward Dividend & Yield", "Ex-Dividend Date", "1y Target Est")
With wsSource
lastRow = GetLastRow(wsSource, 1)
Select Case lastRow
Case Is < 3
Exit Sub
Case 3
ReDim tickers(1, 1): tickers(1, 1) = .Range("A3").Value
Case Is > 3
tickers = .Range("A3:A" & lastRow).Value
End Select
ReDim results(0 To UBound(tickers, 1) - 1)
Dim i As Long, endPoint As Long
endPoint = UBound(headers)
For ticker = LBound(tickers, 1) To UBound(tickers, 1)
If Not IsEmpty(tickers(ticker, 1)) Then
Set html = http.GetHTMLDoc("https://finance.yahoo.com/quote/" & tickers(ticker, 1) & "/?p=" & tickers(ticker, 1))
results(ticker - 1) = http.GetInfo(html, endPoint)
Set html = Nothing
Else
results(ticker) = vbNullString
End If
Next
.Cells(2, 1).Resize(1, UBound(headers) + 1) = headers
For i = LBound(results) To UBound(results)
.Cells(3 + i, 2).Resize(1, endPoint-1) = results(i)
Next
End With
Application.ScreenUpdating = True
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
结果:
关于 GetInfo
方法和 CSS 选择器的注释:
GetInfo
的 class 方法使用 css 组合选择器从每个网页中提取信息以定位页面样式。
我们在每个页面上查找的信息是两个相邻 table 中的房子,例如:
与其乱搞多个 table,我只是将所有 table 单元格作为目标,在 table body 元素中,选择器组合为 tbody td
.
CSS 选择器组合通过 HTMLDocument
的 querySelectorAll
方法应用,return 静态 nodeList
.
returned nodeList
项在偶数索引处有 headers,在奇数索引处有所需的数据。我只想要前两个 tables 的信息,所以我终止了 returned nodeList
的循环,当我给出了感兴趣的 headers 长度的两倍时。我使用索引 1 中的第 2 步循环仅检索感兴趣的数据,减去 headers.
returned nodeList
的样例:
参考资料(VBE > 工具 > 参考资料):
- 微软HTMLObject库
阿尔法优势 API:
快速查看 time series API
调用表明可以使用字符串
https://www.alphavantage.co/query?function=TIME_SERIES_DAILY&symbol=AA&outputsize=full&apikey=yourAPIKey
这会产生一个 JSON 响应,在整个 returned 字典的 Time Series (Daily)
子字典中,有 199 个日期 returned。每个日期都有以下信息:
稍微深入研究文档将揭示是否可以捆绑代码,我无法快速看到这一点,以及是否可以通过不同的查询字符串获得更多您最初感兴趣的项目。
还有更多信息,例如,在 URL 调用中使用 TIME_SERIES_DAILY_ADJUSTED
函数
https://www.alphavantage.co/query?function=TIME_SERIES_DAILY_ADJUSTED&symbol=AA&outputsize=full&apikey=yourAPIkey
在这里,您将得到以下内容:
您可以使用 JSON 解析器(例如 JSONConverter.bas)解析 JSON 响应,并且还有用于 csv 下载的选项。
* 值得研究一下哪些 API 提供了最多的项目覆盖率。 Alpha Vantage 似乎没有覆盖我上面的代码检索到的那么多。
这是一些漂亮的代码!!我很喜欢!!顺便说一句,您可能想考虑使用 R 来做这种事情。看看你可以用几行简单的代码做些什么!
library(finreportr)
# print available functions in finreportr
ls('package:finreportr')
my.ticker <- 'SBUX'
# set final year
my.year <- 2017
# get income for FB
my.income <- GetIncome(my.ticker, my.year)
# print result
print(head(my.income))
# get unique fields
unique.fields <- unique(my.income$Metric)
# cut size of string
unique.fields <- substr(unique.fields,1, 60)
# print result
print(unique.fields)
# set col and date
my.col <- 'Earnings Per Share, Basic'
# print earnings per share
print(my.income[my.income$Metric == my.col, ])
library(tidyquant)
# set stock and dates
my.ticker <- 'AAPL'
first.date <- '2017-01-01'
last.date <- Sys.Date()
# get data with tq_get
my.df <- tq_get(my.ticker,
get = "stock.prices",
from = first.date,
to = last.date)
print(tail(my.df))
# get key financial rations of AAPL
df.key.ratios <- tq_get("AAPL",get = "key.ratios")
# print it
print(df.key.ratios)