- Katılım
- 20 Eylül 2022
- Mesajlar
- 72
- Excel Vers. ve Dili
- 2021 TR
Selam ,
Çalışılan dosyada veri çekmek için kullanılan dışarıdan import edilmiş başka bir dosya var.
Düzenlenmesini istediğim yer bu dosya dışında verilmiş , aşağıda verilen makro üzerinde şu şekildedir;
Dosyada değişiklik yapmak istediğim 2 nokta var , "Veri al" tuşuna bastığım zaman ,
1.si) Kod bölümünde startdate ve enddate olarak verilen sabit bölümleri box sayfasında L2 ve L3 hücrelerine atamak ve değişken haline getirmek istiyorum
2.si) A3'den itibaren listelenmeye başlayan verileri A1 sütunundan başlamak kaydıyla yazdırmak istiyorum( başlık dahil ).
Option Explicit
Public Sub GetYahooHistoricData()
Dim ticker As String, ws As Worksheet, url As String, s As String
Dim startDate As Long, endDate As Long
Set ws = ThisWorkbook.Worksheets("Box")
ticker = ws.Range("L1") 'Range L1. Above write out range
endDate = toUnix("2022-09-20")
startDate = toUnix("2020-09-15")
url = "https://query1.finance.yahoo.com/v8/finance/chart/" & ticker & "?region=US&lang=en-US&includePrePost=false&interval=1d&period1=" & startDate & "&period2=" & endDate & "&corsDomain=finance.yahoo.com&.tsrc=finance"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
s = .responseText
End With
Dim json As Object
Set json = JsonConverter.ParseJson(s)("chart")("result")
Dim dates As Object, results(), rows As Object, adjClose As Object, r As Long, headers()
headers = Array("date", "open", "high", "low", "close")
Set dates = json(1)("timestamp")
ReDim results(1 To dates.Count, 1 To UBound(headers) + 1)
Set rows = json(1)("indicators")("quote")(1)
Set adjClose = json(1)("indicators")("adjclose")(1)("adjclose")
For r = 1 To dates.Count
results(r, 1) = GetDate(dates(r))
results(r, 5) = rows("close")(r)
results(r, 2) = rows("open")(r)
results(r, 3) = rows("high")(r)
results(r, 4) = rows("low")(r)
Next
With ws
.Cells(3, 1).Resize(1, UBound(headers) + 1) = headers
.Cells(4, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End With
End Sub
Public Function GetDate(ByVal t As Variant) As String
GetDate = Format$(t / 86400 + DateValue("1970-01-01"), "yyyy-mm-dd")
End Function
Public Function toUnix(ByVal dt As Variant) As Long
toUnix = DateDiff("s", "1/1/1970", dt)
End Function
Çalışılan dosyada veri çekmek için kullanılan dışarıdan import edilmiş başka bir dosya var.
Düzenlenmesini istediğim yer bu dosya dışında verilmiş , aşağıda verilen makro üzerinde şu şekildedir;
Dosyada değişiklik yapmak istediğim 2 nokta var , "Veri al" tuşuna bastığım zaman ,
1.si) Kod bölümünde startdate ve enddate olarak verilen sabit bölümleri box sayfasında L2 ve L3 hücrelerine atamak ve değişken haline getirmek istiyorum
2.si) A3'den itibaren listelenmeye başlayan verileri A1 sütunundan başlamak kaydıyla yazdırmak istiyorum( başlık dahil ).
Option Explicit
Public Sub GetYahooHistoricData()
Dim ticker As String, ws As Worksheet, url As String, s As String
Dim startDate As Long, endDate As Long
Set ws = ThisWorkbook.Worksheets("Box")
ticker = ws.Range("L1") 'Range L1. Above write out range
endDate = toUnix("2022-09-20")
startDate = toUnix("2020-09-15")
url = "https://query1.finance.yahoo.com/v8/finance/chart/" & ticker & "?region=US&lang=en-US&includePrePost=false&interval=1d&period1=" & startDate & "&period2=" & endDate & "&corsDomain=finance.yahoo.com&.tsrc=finance"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.setRequestHeader "User-Agent", "Mozilla/5.0"
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
s = .responseText
End With
Dim json As Object
Set json = JsonConverter.ParseJson(s)("chart")("result")
Dim dates As Object, results(), rows As Object, adjClose As Object, r As Long, headers()
headers = Array("date", "open", "high", "low", "close")
Set dates = json(1)("timestamp")
ReDim results(1 To dates.Count, 1 To UBound(headers) + 1)
Set rows = json(1)("indicators")("quote")(1)
Set adjClose = json(1)("indicators")("adjclose")(1)("adjclose")
For r = 1 To dates.Count
results(r, 1) = GetDate(dates(r))
results(r, 5) = rows("close")(r)
results(r, 2) = rows("open")(r)
results(r, 3) = rows("high")(r)
results(r, 4) = rows("low")(r)
Next
With ws
.Cells(3, 1).Resize(1, UBound(headers) + 1) = headers
.Cells(4, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End With
End Sub
Public Function GetDate(ByVal t As Variant) As String
GetDate = Format$(t / 86400 + DateValue("1970-01-01"), "yyyy-mm-dd")
End Function
Public Function toUnix(ByVal dt As Variant) As Long
toUnix = DateDiff("s", "1/1/1970", dt)
End Function