Excel vba - 雅虎股票期权报价未以 csv 格式下载

Question

我能够从 yahoo.finance 获得单个选项报价，其中数据垂直传递到两列（一个标题，一个数据），但我所有尝试水平接收数据的尝试都没有成功。我最终试图编写一个命令，该命令将下载一系列选项报价，这些报价将作为每行一个提供。目前，我什至无法获得一条水平线数据。请帮忙！

如果有其他免费服务（例如 CBOE、Google）可以做到这一点，请告诉我。任何和所有的帮助将不胜感激！

Sub getOption()
    '
    ' Attempting to return a stock option in a csv format with all datat in either one cell or accross 5 cells in one row
    ' data desired to Retrieve:
    '           name = n
    '           previous close = p
    '           ask = a
    '           bid = b
    '           open interest =  o1
    '
     Const YAHOO_FINANCE_URL = "http://finance.yahoo.com/q/?s=SKX160122C00035000" 'retrieves option data vertically with a header, but adding &f=npbao1, /d/quotes.csv or &e=.csv makes it not work at all. 
    On Error Resume Next
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & YAHOO_FINANCE_URL, Destination:=ActiveCell)
        .Name = "qtActiveRange" & Rnd()
        .RefreshStyle = xlOverwriteCells
        .AdjustColumnWidth = False
        .BackgroundQuery = False
        .Refresh
    End With

End Sub

Answer 1

我不确定一次性转置查询的方法，但您可以先将垂直数据放在一个临时范围内，然后将其水平转置到您的目标范围。

Range("D4:N5") = WorksheetFunction.Transpose(Range("A4:B14"))

Range("A4:B14") 是临时范围。 （我选择单元格 A1 并运行您的 getOption）

Range("D4:N5") 是我假设的目标范围。

Answer 2

我不知道 SKX 是什么，但你可以试试这个。将您的代码放在 A 列，从 A7 开始，类似这样。

谷歌 YHOO 百度 国际原子能机构 微软 美国在线 YNDX INSP REDF 新浪 ADBE

然后，运行您的脚本。

Sub GetData()


Dim yahoourl As String
    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim qurl As String
    Dim i As Integer

    Set DataSheet = ActiveSheet

    i = 7
    yahoourl = "http://quote.yahoo.com/d/quotes.csv?s=" + Cells(i, 1)
    i = i + 1
    While Cells(i, 1) <> ""
        yahoourl = yahoourl + "+" + Cells(i, 1)
        i = i + 1
    Wend
    yahoourl = yahoourl + "&f=" + "l1"

QueryQuote:
             With ActiveSheet.QueryTables.Add(Connection:="URL;" & yahoourl, Destination:=DataSheet.Range("C7"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
            End With

    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Columns("C:C").ColumnWidth = 28#
    Cells(2, 3).Select
End Sub