- ©«¤l
- 161
- ¥DÃD
- 26
- ºëµØ
- 0
- ¿n¤À
- 187
- ÂI¦W
- 0
- §@·~¨t²Î
- xp
- ³nÅ骩¥»
- office 2010
- ¾\ŪÅv
- 20
- ©Ê§O
- ¨k
- ¨Ó¦Û
- TW
- µù¥U®É¶¡
- 2011-1-2
- ³Ì«áµn¿ý
- 2022-2-16
|
¦^´_ 1# wufonna
https://www.mobile01.com/topicdetail.php?f=511&t=4737630&p=28
°Ñ¦Ò 274¼Ó ×§ï ªe¬y¹Ï- Sub Getyahoofinance_Jsondata()
- Dim Xmlhttp As Object, FileName As String, Url As String, urla As String, Crumbkey As String, stock As String, startday As String, endday As String
- Dim Jsondata As Object, DecodeJson, temp
- Dim TimeStamp, adjclose, quote_Open, quote_High, quote_Low, quote_Close, quote_Volume
- Dim ttt, I
- Set Jsondata = CreateObject("HtmlFile")
- Jsondata.write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"
- ' Sheets("¤u§@ªí1").Cells.Clear
- ' Sheets("¤u§@ªí1").Range("a1:g1") = Array("Date", "Open", "HIgh", "Low", "Close", "Adj Close", "Volume")
- With ¤u§@ªí1
- Dim AR
- AR = .Range("A1:G4")
- .Range("A:G") = ""
- .Range("A1:G4") = AR
- End With
-
- stock = InputBox("ªÑ²¼¥N¸¹", , "^TWII")
- startday = Format(InputBox("¶}©l¤é´Á(8½X¼Æ¦r)", , "20170101"), "####/##/##")
- endday = Format(InputBox("µ²§ô¤é´Á(8½X¼Æ¦r)", , Format(Date, "yyyymmdd")), "####/##/##")
-
- If startday > endday Or stock = "" Or startday = "" Or endday = "" Then
- MsgBox "¸ê®Æ¿é¤J¿ù»~", vbOKOnly, "½Ð«·s¿é¤J"
- Exit Sub
- End If
-
-
- ttt = Timer
-
- Url = "https://finance.yahoo.com/quote/" & stock & "/history?period1=" & DataToUnixTime(startday) & "&period2=" & DataToUnixTime(endday) & "&interval=1d&filter=history&frequency=1d"
-
- Set Xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
- With Xmlhttp
-
- .Open "GET", Url, False
- .send
-
- Crumbkey = Left(Split(.responsetext, """CrumbStore"":{""crumb"":""")(1), 11)
- urla = "https://query2.finance.yahoo.com/v8/finance/chart/" & stock & "?formatted=true&crumb=" & Crumbkey & "&lang=en-US®ion=US&period1=" & DataToUnixTime(startday) & "&period2=" & DataToUnixTime(endday) & "&interval=1d&events=div%7Csplit&corsDomain=finance.yahoo.com"
- .Open "GET", urla, False
- .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- .setRequestHeader "Referer", Url
- .send
-
- Set DecodeJson = Jsondata.JsonParse(.responsetext)
- Set temp = CallByName(CallByName(CallByName(DecodeJson, "chart", VbGet), "result", VbGet), "0", VbGet)
-
- TimeStamp = Split(CallByName(temp, "timestamp", VbGet), ",")
- adjclose = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "adjclose", VbGet), "0", VbGet), "adjclose", VbGet), ",")
- quote_Open = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "quote", VbGet), "0", VbGet), "open", VbGet), ",")
- quote_High = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "quote", VbGet), "0", VbGet), "high", VbGet), ",")
- quote_Low = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "quote", VbGet), "0", VbGet), "low", VbGet), ",")
- quote_Close = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "quote", VbGet), "0", VbGet), "close", VbGet), ",")
- quote_Volume = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "quote", VbGet), "0", VbGet), "volume", VbGet), ",")
-
-
- End With
-
-
- With ¤u§@ªí1
- Application.ScreenUpdating = False
- For I = 0 To UBound(TimeStamp)
- .Cells(I + 5, 1) = Format(TimeStamp(I) / 86400 + #1/1/1970 8:00:00 AM#, "yyyy/mm/dd")
- .Cells(I + 5, 2) = quote_Open(I)
- .Cells(I + 5, 3) = quote_High(I)
- .Cells(I + 5, 4) = quote_Low(I)
- .Cells(I + 5, 5) = quote_Close(I)
- .Cells(I + 5, 6) = adjclose(I)
- .Cells(I + 5, 7) = quote_Volume(I)
- .Cells.EntireColumn.AutoFit
- ' .Cells(1, 1).Select
- Next I
- ' Application.ScreenUpdating = True
- ' MsgBox "¶}©l¤é´Á" & startday & vbNewLine & "µ²§ô¤é´Á" & endday & vbNewLine & _
- ' "ªÑ²¼¥N¸¹" & stock & vbNewLine & "¸ê®Æµ§¼Æ" & .Range("a1").CurrentRegion.Rows.Count - 1 & "µ§" & vbNewLine & _
- ' "¨Ï¥Î®É¶¡" & Round(Timer - ttt, 2) & "¬í", vbOKOnly, "¤U¸ü§¹¦¨"
- End With
-
-
-
- Set Xmlhttp = Nothing
- Set DecodeJson = Nothing
- Set temp = Nothing
-
- End Sub
- Sub DeleteEmptyRows()
- Dim LastRow As Long, r As Long
-
- With ¤u§@ªí1
- LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
- LastRow = LastRow + .Range("A" & .Rows.Count).End(xlUp).Row
-
- For r = LastRow To 5 Step -1
- If .Cells(r, 2) = "" Then
- Debug.Print .Cells(r, 1).Value
-
- .Rows(r).Delete
- End If
- Next r
- End With
-
- Application.ScreenUpdating = True
- End Sub
- Function DataToUnixTime(dstring) As Long
- DataToUnixTime = (DateValue(dstring) - #1/1/1970 8:00:00 AM#) * 86400
- End Function
½Æ»s¥N½X |
|