3

我正在更快地制作我使用 excel vba 编写的程序。

该程序从 asx 下载股票市场数据。

我想从 2 个网址获取数据:

我的代码

url2 = "http://ichart.finance.yahoo.com/table.txt?s=bhp.ax"

Set XMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")

XMLHTTP.Open "GET", url2, False

XMLHTTP.send

result = XMLHTTP.responseText

ActiveCell.Value = result

Set XMLHTTP = Nothing

URL 1. http://ichart.finance.yahoo.com/table.txt?s=bhp.ax

我的问题。

这个文件非常大。我想我可以简单地存储这些 http 请求的结果并将其打印到调试窗口或直接打印到单元格。但是这些方法似乎正在切断部分数据?

如果我从记事本 ++ 中的 url 2 下载 txt 文件,它有近 200 000 个字符,但它的字符数在 3 -5 000 之间。处理这些请求的最佳方法是什么,以便捕获所有数据并且我可以全部解析之后?

URL 2. 从第一个 URL 我只想要由 YQL 查询产生的 JSON 数据。

我的问题

当您点击下面的链接时,我不确定如何只获取 json 数据,或者如何存储它,以便不会发生 URL 1 遇到的问题(缺少数据)。

http://developer.yahoo.com/yql/console/?q=select%20symbol%2C%20ChangeRealtime%20from%20yahoo.finance.quotes%20where%20symbol%20in%20%28%22YHOO%22%2C%22AAPL %22%2C%22GOOG%22%2C%22MSFT%22%29%20|%20sort%28field%3D%22ChangeRealtime%22%2C%20descending%3D%22true%22%29%0A%09%09&env=http% 3A%2F%2Fdatatables.org%2Falltables.env#h=select%20 *%20from%20yahoo.finance.quotes%20where%20symbol%20in%20%28%22bhp.ax%22%29

非常感谢,乔希。

4

2 回答 2

3

试试这个修改后的代码

Sub GetYahooFinanceTable()
    Dim sURL As String, sResult As String
    Dim oResult As Variant, oData As Variant, R As Long, C As Long

    sURL = "http://ichart.finance.yahoo.com/table.txt?s=bhp.ax"
    Debug.Print "URL: " & sURL
    sResult = GetHTTPResult(sURL)
    oResult = Split(sResult, vbLf)
    Debug.Print "Lines of result: " & UBound(oResult)
    For R = 0 To UBound(oResult)
        oData = Split(oResult(R), ",")
        For C = 0 To UBound(oData)
            ActiveSheet.Cells(R + 1, C + 1) = oData(C)
        Next
    Next
    Set oResult = Nothing
End Sub

Function GetHTTPResult(sURL As String) As String
    Dim XMLHTTP As Variant, sResult As String

    Set XMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    XMLHTTP.Open "GET", sURL, False
    XMLHTTP.Send
    Debug.Print "Status: " & XMLHTTP.Status & " - " & XMLHTTP.StatusText
    sResult = XMLHTTP.ResponseText
    Debug.Print "Length of response: " & Len(sResult)
    Set XMLHTTP = Nothing
    GetHTTPResult = sResult
End Function

这会将数据拆分为行,因此单元格中不会达到最大文本长度。这也进一步将带有逗号的数据拆分为相应的列。

在此处输入图像描述

于 2013-08-12T02:59:45.900 回答
0

您可能想尝试以下来自http://investexcel.net/importing-historical-stock-prices-from-yahoo-into-excel/的代码

我只是将 qurl 变量修改为您的 url 并且它可以工作,它将 4087 行数据倒入我的 excel 表中,格式很好,没有任何问题。只需将您的 sheet1 命名为 Data。

    Sub GetData()
    Dim DataSheet As Worksheet
    Dim EndDate As Date
    Dim StartDate As Date
    Dim Symbol As String
    Dim qurl As String
    Dim nQuery As Name
    Dim LastRow As Integer

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Sheets("Data").Cells.Clear

    Set DataSheet = ActiveSheet

'        StartDate = DataSheet.Range("startDate").Value
'        EndDate = DataSheet.Range("endDate").Value
'        Symbol = DataSheet.Range("ticker").Value
'        Sheets("Data").Range("a1").CurrentRegion.ClearContents

'        qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol
'        qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
'            "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
'            Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Sheets("Data").Range("a1") & "&q=q&y=0&z=" & _
'            Symbol & "&x=.csv"


        qurl = "http://ichart.finance.yahoo.com/table.txt?s=bhp.ax"
        Debug.Print qurl

QueryQuote:
             With Sheets("Data").QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("Data").Range("a1"))
                .BackgroundQuery = True
                .TablesOnlyFromHTML = False
                .Refresh BackgroundQuery:=False
                .SaveData = True
            End With

            Sheets("Data").Range("a1").CurrentRegion.TextToColumns Destination:=Sheets("Data").Range("a1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                Semicolon:=False, Comma:=True, Space:=False, other:=False

         Sheets("Data").Columns("A:G").ColumnWidth = 12

    LastRow = Sheets("Data").UsedRange.Row - 2 + Sheets("Data").UsedRange.Rows.Count

    Sheets("Data").Sort.SortFields.Add Key:=Range("A2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets("Data").Sort
        .SetRange Range("A1:G" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        .SortFields.Clear
    End With

End Sub

(以上不是我的代码,取自他们在上面investexcel.net链接上发布的excel文件)

于 2014-03-28T06:23:06.127 回答