Question

以下是我目前的代码：

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列中。

我知道雅虎API，并且正在使用它，但它不起作用，因为我需要5年标准偏差，雅虎不提供。

我希望Macro能够从B列中提取符号，并在URL的末尾生成一个带有该符号的QueryTable。有没有比在不同工作表上创建10个不同的具有10个不同QueryTable的宏更有效的方法呢？

谢谢！

编辑：似乎当我尝试在一个工作表上创建多个QueryTable时，它们只是堆叠在一起:(

Answer 1

将params添加到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

Answer 2

请试试这个。在新工作簿中运行

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

Answer 3

使用同一个表来提取多个数据源的粗略示例。每次更新后都会处理数据

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

VBA - 生成多个QueryTable？

3 个答案:

实施例

实施例