[英]VBA - Generating multiple QueryTables?
这是我目前拥有的代码:
Sub Test()
Dim ws As Worksheet
Dim qt As QueryTable
Dim URL As String
Dim Symbol As String
Set mep = Worksheets ("Managed Equity Portfolios")
Set ws = Worksheets("Hidden Sheet 3")
Symbol = Symbol & mep.Range("B5").Value
URL = "https://www.google.com/finance?q=MUTF:" + Symbol
Set qt = ws.QueryTables.Add( _
Connection:="URL;" & URL, _
Destination:=ws.Range("A1"))
qt.Refresh
Dim URL1 As String
Dim qt1 As QueryTable
Dim Symbol1 As String
Symbol1 = Symbol1 & mep.Range("B6").Value
URL1 = "https://www.google.com/finance?q=MUTF:" + Symbol1
Set qt1 = ws.QueryTables.Add( _
Connection:="URL1;" & URL1, _
Destination:=ws.Range("J1"))
qt1.Refresh
End Sub
因此,当前在链接中,我要提取的股票信息的符号位于URL的末尾“ JLVIX”
我的所有符号都在不同的工作表中,都在B列中。
我知道yahoo API并正在使用它,但是它无法正常工作,因为我需要yahoo不提供的5年标准差。
我希望宏能够从B列中提取符号,并使用URL末尾的符号生成QueryTable。 与在不同的工作表上使用10个不同的QueryTables创建10个不同的宏相比,有没有更有效的方法?
谢谢!
编辑:似乎当我尝试在一个工作表上创建多个QueryTable时,它们只是彼此堆叠:(
向Sub
添加参数,以便您可以在带有所有工作表/权益符号的循环内针对不同的上下文调用它。
如果您只需要5年标准偏差,则可以将Sub
更改为返回该值的Function
。
Function get5YearStd(symbol As String) As Double
Dim ws As Worksheet
Dim qt As QueryTable
Dim URL As String
Set ws = Worksheets("Hidden Sheet 3") 'Or any other sheet
URL = "https://www.google.com/finance?q=MUTF:" + symbol
Set qt = ws.QueryTables.Add( _
Connection:="URL;" & URL, _
Destination:=ws.Range("A1") _
)
With qt
.RefreshStyle = xlOverwriteCells 'So the queries are always overwritten
.BackgroundQuery = False 'It needs to wait before fetching the updated value
.Refresh
End With
get5YearStd = ws.Range("D46").Value 'Range where the 5yr std.dev is
End Function
然后让另一个子程序在循环内为所有符号调用此函数
Sub test()
Dim rng1 As Range
Dim rng2 As Range
Dim equities As Range
Dim ws As Worksheet
Dim stddev As Double
Set ws = Worksheets("Managed Equity Portfolios")
Set rng1 = ws.Range("B5:B9")
Set rng2 = ws.Range("B11:B12")
'Loop over each cell in the informed ranges and call the function to retrive the data
For Each rng In Union(rng1, rng2)
stddev = get5YearStd(rng.Value)
Next
Debug.Print stddev
'Clear up connections created
For Each cn In ActiveWorkbook.Connections
cn.Delete
Next
'Clear variables
Set ws = Nothing
Set rng1 = Nothing
Set rng2 = Nothing
End Sub
请尝试这个。 在新工作簿中运行
Sub Test()
Dim URL As String
URL = "https://www.google.com/finance?q=MUTF:JLVIX"
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Dim tc As Integer
tc = ws.QueryTables.Count
If tc > 0 Then
Dim i As Integer
For i = tc To 1 Step -1 ' delete any tables that may be in the worksheet
ws.QueryTables(i).Deleteworksheet
Next i
End If
Dim qt1 As QueryTable
Set qt1 = ws.QueryTables.Add( _
Connection:="URL;" & URL, _
Destination:=ws.Range("A1"))
Dim qt2 As QueryTable
Set qt2 = ws.QueryTables.Add( _
Connection:="URL;" & URL, _
Destination:=ws.Range("H1"))
qt2.Refresh ' fill second one first, just to see what happens
qt2.ResultRange.Select ' this is just to highlight the range
Stop ' check worksheet now
qt1.Refresh
qt1.ResultRange.Select ' this is just to highlight the range
End Sub
使用同一表提取多个数据源的粗略示例。 每次更新后都会处理数据
Sub Test()
Dim URL As String
URL = "https://www.google.com/finance?q=MUTF:JLVIX"
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Dim i As Integer
For i = 1 To ws.QueryTables.Count
ws.QueryTables(1).Delete
Next i
Dim qt As QueryTable
Set qt = ws.QueryTables.Add( _
Connection:="URL;" & URL, _
Destination:=ws.Range("A1"))
qt.Refresh
qt.ResultRange.Select ' this is just to highlight the range
Stop ' check worksheet now
qt.ResultRange.ClearContents
Stop ' check worksheet now
qt.Connection = "URL;https://www.google.com/finance?q=MUTF:IBM"
qt.Destination = ws.Range("G3") ' this does not move the range
Stop ' check worksheet now
qt.Refresh
qt.ResultRange.Select ' this is just to highlight the range
Stop ' process data here
qt.ResultRange.ClearContents
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.