Tirer des données de stock historiques pour plusieurs entresockets utilisant l'API YAHOO dans Excel

Je travaille sur un projet dans Excel qui vous donnera la valeur de votre portefeuille et calculera également d'autres statistics utiles sur vos participations. (SD.dev du portefeuille, la version bêta de votre portefeuille, etc.).

J'ai déjà utilisé Yahoo Finance pour extraire les statistics intraday (nom de la société, dernier prix du commerce, ouvert, élevé, bas, etc.). Cette partie était assez simple, il suffit d'append le symbole et "+" dans l'URL et il tire toutes datatables pour chaque stock.

Ce que j'essaie de faire, c'est tirer les prix historiques de clôture pour tous les stocks du portefeuille (malheureusement, la même logique d'append le symbole ticker et "+" à l'URL ne fonctionne pas pour cela).

Voici le code que j'ai suivi. Sur "Sheet1", les positions du portefeuille sont (les symboles Ticker commencent à la cellule A2 et descendent). La Feuille 2 prend les symboles du ticker et les affichera en haut dans la rangée 2 avec l'URL pour chaque ticker correspondant au-dessus de la ligne 1.

De plus, les dates de début et de fin sont dans la feuille 2 cellules C 4 et 5, respectivement.

Le but est d'essayer d'get un excellent niveau pour get le .CSV pour chaque symbole du ticker et save le prix de clôture dans la colonne correspondante.

Peut-être que je vais tout faire faux et il y a un moyen beaucoup plus facile d'get ces données, mais toute aide serait appréciée.

Merci d'avance!

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 Ssortingng: strtMonth = Month(strtDate) Dim strtDay As Ssortingng: strtDay = Day(strtDate) Dim strtYear As Ssortingng: strtYear = Year(strtDate) Dim endMonth As Ssortingng: endMonth = Month(endDate) Dim endDay As Ssortingng: endDay = Day(endDate) Dim endYear As Ssortingng: endYear = Year(endDate) '------------------------------------------------------------------------------------------------------------------------------------- Dim urlStartRange As Ssortingng: urlStartRange = "&a=" & strtMonth & "&b=" & strtDay & "&c=" & strtYear ' This goes into URL for start date Dim urlEndRange As Ssortingng: urlEndRange = "&d=" & endMonth & "e=" & endDay & "&f=" & endYear & "&g=d&ignore=.csv" 'this goes into the URL as end date '------------------------------------------------------------------------------------------------------------------------------------- 'creates a ssortingng of all symbols separated by "+" Dim urlSymbols As Ssortingng 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 Ssortingng: httpResp = getHttp.ResponseText Dim dataLines As Variant: dataLines = Split(httpResp, vbTab) Dim splitDataLines As Ssortingng 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 

DEVINER.

Juste pris beaucoup de fractionnement et beaucoup de loops.

Bien sûr, je suis sûr que cela peut être scénarisé plus élégamment.

À votre santé!

 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 Ssortingng: strtMonth = Month(strtDate) - 1 Dim strtDay As Ssortingng: strtDay = Day(strtDate) Dim strtYear As Ssortingng: strtYear = Year(strtDate) Dim endMonth As Ssortingng: endMonth = Month(endDate) - 1 Dim endDay As Ssortingng: endDay = Day(endDate) Dim endYear As Ssortingng: endYear = Year(endDate) '------------------------------------------------------------------------------------------------------------------------------------- Dim urlStartRange As Ssortingng: urlStartRange = "&a=" & strtMonth & "&b=" & strtDay & "&c=" & strtYear ' This goes into URL for start date Dim urlEndRange As Ssortingng: urlEndRange = "&d=" & endMonth & "&e=" & endDay & "&f=" & endYear & "&g=d&ignore=.csv" 'this goes into the URL as end date '------------------------------------------------------------------------------------------------------------------------------------- 'creates a ssortingng of all symbols separated by "+" Dim urlSymbols As Ssortingng 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 Ssortingng: httpResp = getHttp.ResponseText Dim dataLines As Variant: dataLines = Split(httpResp, vbLf) Dim closeValue As Ssortingng 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