wufonna

回復 9# c_c_lai


    又來請教大大
從網路下載的資料是日期反的，而圖表反向，
請問 大大要修改那個地方
謝謝

c_c_lai

回復 11# wufonna

1. Sub MySort()
   
2.      Dim EndKBarRow As Long
   
3.         
   
4.     With Sheets("data")
   
5.         EndKBarRow = .Range("A" & Rows.Count).End(xlUp).Row
   
6.    
   
7.         With .Sort
   
8.             .SortFields.clear
   
9.             .SortFields.Add Key:=Range("A5"), SortOn:=xlSortOnValues, Order:=xlAscending
   
10.             '  資料由小而大依序排序
    
11.             '  .SortFields.Add Key:=Range("A5"), SortOn:=xlSortOnValues, Order:=xlDescending
    
12.             '  資料由大而小依序排序
    
13.             .SetRange Range("A5:R" & EndKBarRow)
    
14.             ' .Header = xlNone
    
15.             .Apply
    
16.         End With
    
17.     End With
    
18. End Sub

複製代碼

wufonna

回復 12# c_c_lai


    感謝大大，已作出大盤，謝謝 ^o^

c_c_lai

回復 13# wufonna
你在 drawCharts() 最前、及最後加上一行 (如下) 繪圖完成後畫面會更清爽。

1. Sub drawCharts()
   
2.     Dim toindexRows As Single, totalRows As Single, totalRows2 As Single
   
3.     Dim VIMax As Single, VIMin As Single
   
4.     Dim xRow, yCol, cHeight, cWidth As Integer
   
5.     Dim text As String
   
6.     Dim chartname As String
   
7.     Dim sRowHeight As Single
   
8. 
   
9.     '  xRow = 3
   
10.     xRow = 1
    
11.     yCol = 1
    
12.     '  cHeight = 450      'CHeight 定義為圖表所佔的列高
    
13.     '  cWidth = 700
    
14.     cHeight = 360         ' CHeight 定義為圖表所佔的列高
    
15.     cWidth = 720

複製代碼

1.     Sheets("chart").[A1].Select
   
2. End Sub

複製代碼

c_c_lai

回復 13# wufonna
我在 drawCharts() 加了一小段程式，它將標題移出繪圖區，
如此，比較不會壓到 K 線圖的繪製 (附上： 前、後的圖表提供比較)：

1.         .ChartArea.Height = cHeight                     ' 圖表高度
   
2.         .ChartArea.Width = cWidth                       ' 圖表寬度
   
3.          '
   
4.         With .PlotArea                          ' 圖表的繪圖區
   
5.             .Top = 20                           ' 圖表的實際繪圖區起始位置
   
6.             .Left = 1
   
7.             .Width = .Parent.ChartArea.Width
   
8.             .Height = .Parent.ChartArea.Height
   
9.             .Interior.ColorIndex = xlNone
   
10.             .InsideHeight = cHeight - 70        ' 調整圖表的繪圖區內部高度 (為配合.Legend.Position = xlBottom )
    
11.         End With

複製代碼

下載 (64.19 KB)

2013-10-12 07:35

下載 (63.69 KB)

2013-10-12 07:35

wufonna

回復 15# c_c_lai


    謝謝 大大
   找了好久來到了這版版，又看到了大大的 K 線股票圖如何能與主力、散戶、及成交量線共存？ 線圖共存，學習做流河圖，謝謝 大大 無私的教導。

c_c_lai

回復 16# wufonna
我將 "台灣加權指數-報酬率區間圖III"  稍稍整理了一下，
並加以程式碼對位，希望對你能有所助益。
drawCharts2() 是我常應用的繪圖方式，供你參考！
台灣加權指數-報酬率區間圖III.rar (921.68 KB)

下載次數: 18

2013-10-13 14:26

wufonna

回復 17# c_c_lai


    謝謝 大大  ^0^

wufonna

河流圖網址無效
參考一些資料
https://finance.yahoo.com/quote/2330.TW/history?period1=1575244800&period2=1631404800&interval=1d&filter=history&frequency=1d&includeAdjustedClose=true


Private Const Unix1970 As Long = 25569 'CDbl(DateSerial(1970, 1, 1))

'Dim s As String

Public Function Date2Unix(ByVal vDate As Date) As Long

Date2Unix = DateDiff("s", Unix1970, vDate)


End Function

Sub test()
Debug.Print s

Debug.Print DateDiff("s", Unix1970, vDate)
Debug.Print Date2Unix("2019/6/7")
Debug.Print Date2Unix(Date - 365 * 3)  '取三年
Debug.Print Now()
Debug.Print Date
Debug.Print Date2Unix(Date)
Debug.Print "https://finance.yahoo.com/quote/2330.TW/history?period1=" & Date2Unix("2019/6/7") & "&period2=" & Date2Unix(Date) & "&interval=1d&filter=history&frequency=1d&includeAdjustedClose=true"

End Sub



'debug
'

'-2209161600
' 1559865600
' 1536796800
'2021/9/12 下午 09:45:15
'2021/9/12
' 1631404800
'https://finance.yahoo.com/quote/2330.TW/history?period1=1559865600&period2=1631404800&interval=1d&filter=history&frequency=1d&includeAdjustedClose=true





'https://white5168.blogspot.com/2017/03/unix-timestamp-excel-vba.html?fbclid=IwAR1FQDyY3A1utM3vaT24SKcoybW02PUycFBWuW8JXncdCfzk5wTEDZgi3vw#.YT33950zbcs
'https://www.cadch.com/article/timestamp/index.php
'https://finance.yahoo.com/quote/2330.TW/history?period1=1575244800&period2=1631404800&interval=1d&filter=history&frequency=1d&includeAdjustedClose=true
'http://forum.twbts.com/thread-22471-1-2.html?fbclid=IwAR0V3t8wojYYInLQXamUi6ZJqPeSRQGHhSR9RBia2xRh5YJw2ZIUvxMDWSw
'參考資料

'debug.print https://finance.yahoo.com/quote/2330.TW/history?period1=" & Date2Unix("2019/6

wufonna

回復 1# wufonna

https://www.mobile01.com/topicdetail.php?f=511&t=4737630&p=28

參考 274樓 修改 河流圖

1. Sub Getyahoofinance_Jsondata()
   
2. 
   
3.     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
   
4.     Dim Jsondata As Object, DecodeJson, temp
   
5.     Dim TimeStamp, adjclose, quote_Open, quote_High, quote_Low, quote_Close, quote_Volume
   
6.     Dim ttt, I
   
7.     Set Jsondata = CreateObject("HtmlFile")
   
8.     Jsondata.write "<script>document.JsonParse=function (s) {return eval('(' + s + ')');}</script>"
   
9. 
   
10. '    Sheets("工作表1").Cells.Clear
    
11. '    Sheets("工作表1").Range("a1:g1") = Array("Date", "Open", "HIgh", "Low", "Close", "Adj Close", "Volume")
    
12.     With 工作表1
    
13.           Dim AR
    
14.            AR = .Range("A1:G4")
    
15.            .Range("A:G") = ""
    
16.            .Range("A1:G4") = AR
    
17.     End With
    
18.    
    
19.     stock = InputBox("股票代號", , "^TWII")
    
20.     startday = Format(InputBox("開始日期(8碼數字)", , "20170101"), "####/##/##")
    
21.     endday = Format(InputBox("結束日期(8碼數字)", , Format(Date, "yyyymmdd")), "####/##/##")
    
22.    
    
23.     If startday > endday Or stock = "" Or startday = "" Or endday = "" Then
    
24.         MsgBox "資料輸入錯誤", vbOKOnly, "請重新輸入"
    
25.         Exit Sub
    
26.     End If
    
27.    
    
28.   
    
29.     ttt = Timer
    
30.    
    
31.     Url = "https://finance.yahoo.com/quote/" & stock & "/history?period1=" & DataToUnixTime(startday) & "&period2=" & DataToUnixTime(endday) & "&interval=1d&filter=history&frequency=1d"
    
32.    
    
33.     Set Xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    
34.     With Xmlhttp
    
35.    
    
36.        .Open "GET", Url, False
    
37.        .send
    
38.       
    
39.         Crumbkey = Left(Split(.responsetext, """CrumbStore"":{""crumb"":""")(1), 11)
    
40.         urla = "https://query2.finance.yahoo.com/v8/finance/chart/" & stock & "?formatted=true&crumb=" & Crumbkey & "&lang=en-US&region=US&period1=" & DataToUnixTime(startday) & "&period2=" & DataToUnixTime(endday) & "&interval=1d&events=div%7Csplit&corsDomain=finance.yahoo.com"
    
41. 
    
42.        .Open "GET", urla, False
    
43.        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
44.        .setRequestHeader "Referer", Url
    
45.        .send
    
46.         
    
47.         Set DecodeJson = Jsondata.JsonParse(.responsetext)
    
48.         Set temp = CallByName(CallByName(CallByName(DecodeJson, "chart", VbGet), "result", VbGet), "0", VbGet)
    
49.         
    
50.         TimeStamp = Split(CallByName(temp, "timestamp", VbGet), ",")
    
51.         adjclose = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "adjclose", VbGet), "0", VbGet), "adjclose", VbGet), ",")
    
52.         quote_Open = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "quote", VbGet), "0", VbGet), "open", VbGet), ",")
    
53.         quote_High = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "quote", VbGet), "0", VbGet), "high", VbGet), ",")
    
54.         quote_Low = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "quote", VbGet), "0", VbGet), "low", VbGet), ",")
    
55.         quote_Close = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "quote", VbGet), "0", VbGet), "close", VbGet), ",")
    
56.         quote_Volume = Split(CallByName(CallByName(CallByName(CallByName(temp, "indicators", VbGet), "quote", VbGet), "0", VbGet), "volume", VbGet), ",")
    
57.         
    
58.       
    
59.     End With
    
60.    
    
61.    
    
62.     With 工作表1
    
63.         Application.ScreenUpdating = False
    
64.         For I = 0 To UBound(TimeStamp)
    
65.             .Cells(I + 5, 1) = Format(TimeStamp(I) / 86400 + #1/1/1970 8:00:00 AM#, "yyyy/mm/dd")
    
66.             .Cells(I + 5, 2) = quote_Open(I)
    
67.             .Cells(I + 5, 3) = quote_High(I)
    
68.             .Cells(I + 5, 4) = quote_Low(I)
    
69.             .Cells(I + 5, 5) = quote_Close(I)
    
70.             .Cells(I + 5, 6) = adjclose(I)
    
71.             .Cells(I + 5, 7) = quote_Volume(I)
    
72.             .Cells.EntireColumn.AutoFit
    
73.        '     .Cells(1, 1).Select
    
74.         Next I
    
75. '        Application.ScreenUpdating = True
    
76. '        MsgBox "開始日期" & startday & vbNewLine & "結束日期" & endday & vbNewLine & _
    
77. '        "股票代號" & stock & vbNewLine & "資料筆數" & .Range("a1").CurrentRegion.Rows.Count - 1 & "筆" & vbNewLine & _
    
78. '        "使用時間" & Round(Timer - ttt, 2) & "秒", vbOKOnly, "下載完成"
    
79.     End With
    
80.    
    
81.    
    
82.    
    
83.     Set Xmlhttp = Nothing
    
84.     Set DecodeJson = Nothing
    
85.     Set temp = Nothing
    
86.    
    
87. End Sub
    
88. 
    
89. Sub DeleteEmptyRows()
    
90. Dim LastRow As Long, r As Long
    
91. 
    
92.    
    
93. With 工作表1
    
94. LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    
95. LastRow = LastRow + .Range("A" & .Rows.Count).End(xlUp).Row
    
96. 
    
97. For r = LastRow To 5 Step -1
    
98.     If .Cells(r, 2) = "" Then
    
99.     Debug.Print .Cells(r, 1).Value
    
100.    
     
101.     .Rows(r).Delete
     
102.     End If
     
103.     Next r
     
104. 
     
105. End With
     
106. 
     
107.         Application.ScreenUpdating = True
     
108. 
     
109. End Sub
     
110. 
     
111. Function DataToUnixTime(dstring) As Long
     
112.     DataToUnixTime = (DateValue(dstring) - #1/1/1970 8:00:00 AM#) * 86400
     
113. End Function

複製代碼