Question

我正在Excel中开展一个项目，它将为您提供投资组合的价值，并计算一些有关您馆藏的有用统计数据。（投资组合的st.dev，您的投资组合的测试版等）。

我已经使用雅虎财经来提取日内统计数据（公司名称，最后交易价格，开盘价，最高价，最低价等）。那部分是相当直接的，您只需在URL中添加符号和“+”，它就可以获取每个股票的所有数据。

我想要做的是拉动投资组合中所有股票的历史收盘价（遗憾的是，在URL中添加股票代码和“+”的相同逻辑对此不起作用）。

以下是我到目前为止的代码。在“Sheet1”上是投资组合持有的地方（Ticker符号从A2开始向下）。工作表2将采用股票代码符号并在第2行的顶部显示它们，并在第1行中的每个相应股票代码的网址上显示。

开始和结束日期也分别在表2单元格C 4和5中。

目标是尝试获得excel以获得每个股票代码的.CSV，并在相应的列中记录收盘价。

也许我认为这一切都是错误的，并且有更简单的方法来获取这些数据，但任何帮助都会受到赞赏。

提前谢谢！

Private Sub btnHistoricalData_Click()

Dim W As Worksheet: Set W = ActiveSheet
Dim DataW As Worksheet: Set DataW = ActiveWorkbook.Sheets("Sheet1") ' This is where you enter the stocks in your portfolio
Dim Last As Integer: Last = W.Range("c2").End(xlToRight).Column
Dim dataLast As Integer: dataLast = DataW.Range("A2").End(xlDown).Row

'*************************************************************************************
If Last <> dataLast Then
    W.Rows(2).Clear ' clears row if values are different so correct data can be enterred into this row
End If
'*************************************************************************************
Dim i As Integer
For i = 1 To dataLast
    W.Cells(2, 3 + i).Value = DataW.Cells(1 + i, 1).Value
Next i


Dim strtDate As Date: strtDate = W.Range("B4").Value 'Starting Date
Dim endDate As Date: endDate = W.Range("B5").Value 'End Date
 '-------------------breaks down starting month, day and year to be entered into the URL -------------------
        Dim strtMonth As String: strtMonth = Month(strtDate)
        Dim strtDay As String: strtDay = Day(strtDate)
        Dim strtYear As String: strtYear = Year(strtDate)
        Dim endMonth As String: endMonth = Month(endDate)
        Dim endDay As String: endDay = Day(endDate)
        Dim endYear As String: endYear = Year(endDate)
'-------------------------------------------------------------------------------------------------------------------------------------

Dim urlStartRange As String: urlStartRange = "&a=" & strtMonth & "&b=" & strtDay & "&c=" & strtYear ' This goes into URL for start date
Dim urlEndRange As String: urlEndRange = "&d=" & endMonth & "e=" & endDay & "&f=" & endYear & "&g=d&ignore=.csv" 'this goes into the URL as end date
'-------------------------------------------------------------------------------------------------------------------------------------

'creates a string of all symbols separated by "+"
Dim urlSymbols As String
For i = 0 To dataLast
    urlSymbols = urlSymbols & W.Cells(2, 4 + i).Value & "+"
Next i
urlSymbols = Left(urlSymbols, Len(urlSymbols) - 3) 'gets rid of extra "+" values

 Dim splitUrlSymbols As Variant: splitUrlSymbols = Split(urlSymbols, Chr(43))
 For i = 0 To dataLast - 2
       W.Cells(1, 4 + i).Value = "http://ichart.finance.yahoo.com/table.csv?s=" & splitUrlSymbols(i) & urlStartRange & urlEndRange
 Next i
   'Pulls data from YAHOO Finance --------------
Dim getHttp As New WinHttpRequest
'For i = 0 To lastdata - 2 **(eventually I need to loop this request through each column for each stock enterred)**
    getHttp.Open "GET", W.Cells(1, 5).Value, False ' *********just selected 1 cell for now****************
    getHttp.Send
    Dim httpResp As String: httpResp = getHttp.ResponseText
    Dim dataLines As Variant: dataLines = Split(httpResp, vbTab)
    Dim splitDataLines As String
    Dim dataValues As Variant
    Dim x As Integer
        For x = 0 To UBound(dataLines)
            splitDataLines = dataLines(x)

           dataValues = Split(splitDataLines, ",")

        Next x
'----------------------------------------------
   ' Next i
    MsgBox (httpResp)


End Sub

Answer 1

计算出来。

花了很多分裂和很多循环。

虽然，我确信它可以更优雅地编写脚本。

干杯！

Dim W As Worksheet: Set W = ActiveSheet
Dim DataW As Worksheet: Set DataW = ActiveWorkbook.Sheets("Sheet1") ' This is where you enter the stocks in your portfolio
Dim Last As Integer: Last = W.Range("d2").End(xlToRight).Column
Dim dataLast As Integer: dataLast = DataW.Range("A2").End(xlDown).Row


'*************************************************************************************
If Last <> dataLast + 2 Then
    W.Rows(2).Clear ' clears row if values are different so correct data can be enterred into this row
        Dim i As Integer
For i = 1 To dataLast
    W.Cells(2, 3 + i).Value = DataW.Cells(1 + i, 1).Value
Next i
End If
'*************************************************************************************



Dim strtDate As Date: strtDate = W.Range("B4").Value 'Starting Date
Dim endDate As Date: endDate = W.Range("B5").Value 'End Date
 '-------------------breaks down starting month, day and year to be entered into the URL -------------------
        Dim strtMonth As String: strtMonth = Month(strtDate) - 1
        Dim strtDay As String: strtDay = Day(strtDate)
        Dim strtYear As String: strtYear = Year(strtDate)
        Dim endMonth As String: endMonth = Month(endDate) - 1
        Dim endDay As String: endDay = Day(endDate)
        Dim endYear As String: endYear = Year(endDate)
'-------------------------------------------------------------------------------------------------------------------------------------

Dim urlStartRange As String: urlStartRange = "&a=" & strtMonth & "&b=" & strtDay & "&c=" & strtYear ' This goes into URL for start date
Dim urlEndRange As String: urlEndRange = "&d=" & endMonth & "&e=" & endDay & "&f=" & endYear & "&g=d&ignore=.csv" 'this goes into the URL as end date
'-------------------------------------------------------------------------------------------------------------------------------------

'creates a string of all symbols separated by "+"
Dim urlSymbols As String
For i = 0 To dataLast
    urlSymbols = urlSymbols & W.Cells(2, 4 + i).Value & "+"
Next i
urlSymbols = Left(urlSymbols, Len(urlSymbols) - 3) 'gets rid of extra "+" values

 Dim splitUrlSymbols As Variant: splitUrlSymbols = Split(urlSymbols, Chr(43))
 For i = 0 To dataLast - 2
       W.Cells(1, 4 + i).Value = "http://ichart.finance.yahoo.com/table.csv?s=" & splitUrlSymbols(i) & urlStartRange & urlEndRange
 Next i
   'Pulls data from YAHOO Finance --------------
For Z = 0 To dataLast - 2
Dim getHttp As New WinHttpRequest

    getHttp.Open "GET", W.Cells(1, Z + 4).Value, False ' *********just selected 1 cell for now****************
    getHttp.Send
    Dim httpResp As String: httpResp = getHttp.ResponseText
    Dim dataLines As Variant: dataLines = Split(httpResp, vbLf)
    Dim closeValue As String
    Dim x As Integer
        For x = 1 To UBound(dataLines) - 4: Debug.Print dataLines(2)
            closeValue = dataLines(x)
            Dim adjClose As Variant: adjClose = Split(closeValue, ",")
                 If InStr(closeValue, ",") > 0 Then
            W.Cells(2 + x, Z + 4).Value = adjClose(6)
                End If
        Next x
    Dim y As Integer
    'Dim adjClose As Variant: adjClose = Split(closeValue, ",")



Next Z

使用Excel中的YAHOO API拉取多家公司的历史库存数据

1 个答案: