[發問] 如何應用 VBA 將股票圖完整的呈現出來？

c_c_lai

如何應用撰寫 VBA 程式將股票圖完整的呈現出來？

這個議題著實也想了一陣子，怎麼畫也只能單純地繪製出一個原始的股票圖，
先別說是再加入其它，如：成交量等，連基本的時間軸也無從同時加入 (請參考附上程式)。
我指的是應用 VBA 來撰寫，而不是直接以 EXCEL 上列的圖表製作。

請教可有否解決之道嗎？
1) 將時間軸能予以同時匯入。
2) 再增加一項  成交量數列，並以 .ChartType = xlColumnClustered 的方式表達 (副座標值)。

附上檔案，謝謝各位先進指教！

股票圖表.rar (26.45 KB)

下載次數: 46

2012-4-23 06:59

下載 (30.73 KB)

2012-4-23 07:18

alexliou

回復 1# c_c_lai
這可以利用 xlStockVOHLC的ChartType來完成
假設日期在A欄,成交量在B欄, 開高低收分別在CDEF欄

n = Range("A1").End(xlDown).Row
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlStockVOHLC       '自動會把日期和成交量帶進去        
ActiveChart.SetSourceData Source:=Range("A1:F" & n)         
With ActiveChart
        .HasLegend = False
        .Axes(xlCategory).CategoryType = xlCategoryScale    'X軸設為Category, 為避免有些日期無交易而造成圖形不連續
End With

alexliou

分成兩步做 且用到xlColumnClustered也是可以
這次加上顏色  上漲Bar用紅色 下跌用藍色

假設日期在A欄, 開高低收分別在BCDE欄, 成交量在F欄

Dim n As Integer
n = Range("A1").End(xlDown).Row
  ActiveSheet.Shapes.AddChart.Select
  ActiveChart.SetSourceData Source:=Range("A1:E" & n)
  ActiveChart.ChartType = xlStockOHLC       '自動會把日期帶進去
  
ActiveChart.ChartGroups(1).UpBars.Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
ActiveChart.ChartGroups(1).DownBars.Format.Fill.ForeColor.RGB = RGB(0, 32, 96)
   
ActiveChart.SeriesCollection.Add Source:=Range("F2:F" & n)    '不包含標題列, 要從2開始
ActiveChart.SeriesCollection(5).ChartType = xlColumnClustered
   
With ActiveChart
        .HasLegend = False
        .Axes(xlCategory).CategoryType = xlCategoryScale
End With

alexliou

另外一種設顏色的方法

n = Range("A1").End(xlDown).Row
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("A1:E" & n)
ActiveChart.ChartType = xlStockOHLC
   
ActiveChart.SeriesCollection.Add Source:=Range("F2:F" & n)   '不包含標題列 要從2開始
ActiveChart.SeriesCollection(5).ChartType = xlColumnClustered
   
With ActiveChart
        .HasLegend = False
        .Axes(xlCategory).CategoryType = xlCategoryScale
End With
   
With ActiveChart.ChartGroups(2)      '注意, ChartGroup在插入成交量直條後變成2了
'如果在插入成交量直條前則要改為1, the sequence of code matters         
            .UpBars.Interior.Color = RGB(255, 0, 0)
            .DownBars.Interior.Color = RGB(0, 32, 96)
End With

c_c_lai

回復 4# alexliou
為了方便您瞭解我測試的資料內容，一一將它們列示出來，並且只保留30筆資料做為測試之用。
程式中我也遵照您的說明加以修正。
成交量業已順利崁入 (副座標值)， 並以 xlColumnClustered 方式呈現 (如附圖)。
接下來我想做的測試是再加上 5MA、20MA、60MA 這三條均線在 股票圖上 (均為主座標值)，
我有測試過但都不成功，甚至連K線圖本身也都會不見。 附上程式碼有空時幫我增添進去測試，
我想是某些地方觀念不正確，沒寫對吧！ 謝謝您！

1.      日期                時間        開盤價        最高價        最低價        成交價        成交量        5MA        20MA        60MA
   
2. 20120418        11:01        7155        7162        7154        7162        490                7153         7151         7158
   
3. 20120418        11:02        7162        7162        7158        7160        206                7155         7152         7158
   
4. 20120418        11:03        7160        7164        7160        7163        295           7157         7152         7158
   
5. 20120418        11:04        7163        7164        7159        7160        196                7160         7153         7158
   
6. 20120418        11:05        7160        7161        7158        7160        118                7161         7153         7158
   
7. 20120418        11:06        7160        7161        7157        7158        125                7160         7154         7158
   
8. 20120418        11:07        7158        7160        7157        7157        77                7160         7154         7158
   
9. 20120418        11:08        7157        7158        7156        7157        121            7158         7155         7158
   
10. 20120418        11:09        7157        7159        7157        7159        60                7158         7155         7157
    
11. 20120418        11:10        7159        7160        7158        7158        73                7158         7156         7157
    
12. 20120418        11:11        7158        7159        7157        7159        114                7158         7156         7157
    
13. 20120418        11:12        7159        7161        7158        7160        88                7159         7157         7157
    
14. 20120418        11:13        7160        7160        7155        7158        184                7159         7157         7156
    
15. 20120418        11:14        7158        7162        7158        7161        122                7159         7157         7156
    
16. 20120418        11:15        7161        7161        7155        7155        143                7159         7157         7156
    
17. 20120418        11:16        7155        7155        7148        7148        391            7156         7157         7156
    
18. 20120418        11:17        7148        7152        7148        7151        166                7155         7157         7155
    
19. 20120418        11:18        7151        7154        7151        7152        76                7153         7157         7155
    
20. 20120418        11:19        7152        7153        7147        7150        278                7151         7157         7155
    
21. 20120418        11:20        7150        7152        7148        7151        130                7150         7157         7155
    
22. 20120418        11:21        7152        7152        7149        7151        110            7151         7156         7154
    
23. 20120418        11:22        7151        7151        7148        7148        139                7150         7156         7154
    
24. 20120418        11:23        7148        7149        7145        7149        317                7150         7155         7154
    
25. 20120418        11:24        7149        7150        7147        7150        107                7150         7155         7154
    
26. 20120418        11:25        7150        7150        7144        7146        382                7149         7154         7154
    
27. 20120418        11:26        7146        7146        7133        7135        2139        7146         7153         7154
    
28. 20120418        11:27        7135        7136        7132        7132        511                7142         7152         7154
    
29. 20120418        11:28        7132        7135        7128        7133        850                7139         7150         7153
    
30. 20120418        11:29        7135        7137        7132        7134        318         7136         7149         7153
    
31. 20120418        11:30        7135        7135        7127        7127        396                7132         7148         7153

複製代碼

下載 (25.67 KB)

2012-4-23 21:04

下載 (35.77 KB)

2012-4-23 21:04

1. Sub DrawAll()
   
2.     Call drawStatistics
   
3.     Call drawOmegaCharts
   
4. End Sub
   
5. 
   
6. Sub drawStatistics()
   
7.     drawCharts ("統計圖表")
   
8. End Sub
   
9. 
   
10. Sub drawOmegaCharts()
    
11.     drawCharts ("Omega")
    
12. End Sub
    
13. 
    
14. Sub removeCharts(st As String)
    
15.     Dim oShape As Shape
    
16.     Dim str As String
    
17.    
    
18.     str = ActiveSheet.Name
    
19.     Sheets(st).Select
    
20.    
    
21.     For Each oShape In ActiveSheet.Shapes
    
22.         If oShape.Type = 3 Then
    
23.             oShape.Delete
    
24.         End If
    
25.     Next
    
26.    
    
27.     Sheets(str).Select
    
28. End Sub
    
29. 
    
30. Sub drawCharts(sta As String)
    
31.     Dim str As String
    
32.    
    
33.     str = ActiveSheet.Name
    
34.     Sheets(sta).Select
    
35. 
    
36.     Call removeCharts(sta)
    
37. 
    
38.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    
39.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    
40.     Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    
41.    
    
42.     With Selection.Borders(xlEdgeTop)
    
43.         .LineStyle = xlContinuous
    
44.         .ColorIndex = 0
    
45.         .TintAndShade = 0
    
46.         .Weight = xlThin
    
47.     End With
    
48.    
    
49.     Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    
50.    
    
51.     With Selection.Borders(xlEdgeRight)
    
52.         .LineStyle = xlContinuous
    
53.         .ColorIndex = 0
    
54.         .TintAndShade = 0
    
55.         .Weight = xlThin
    
56.     End With
    
57.    
    
58.     Call mainPowerForce(sta)
    
59.    
    
60.     Cells(1, 1).Select
    
61.     Sheets(str).Select
    
62. End Sub
    
63. 
    
64. Sub mainPowerForce(sDraw As String)
    
65.     Dim totalRows As Single
    
66.     Dim counter, xRow, yCol, cHeight, cWidth, inLeft, inTop, inWidth As Integer
    
67.     Dim text As String
    
68.     Dim chartname As String
    
69. 
    
70.     totalRows = Sheets("統計圖表").Range("B" & Rows.Count).End(xlUp).Row     ' 傳回 B 欄所使用儲存格之最後一格之列號
    
71.     Sheets(sDraw).Select
    
72.     Cells(1, 11).Value = totalRows
    
73.       
    
74.     ActiveSheet.Shapes.AddChart.Select
    
75.                                              
    
76.     With ActiveChart
    
77.         
    
78.         .SetSourceData Source:=Range("統計圖表!$B$1:統計圖表!$B$" & totalRows & ", 統計圖表!$C$1:統計圖表!$F$" & totalRows)
    
79.         '.SetSourceData Source:=Range(" 統計圖表!$C$1:統計圖表!$F$" & totalRows)
    
80.         ' .ChartType = xlStockVOHLC              ' 股票圖   ( 會造成 記憶體不足 )
    
81.         .ChartType = xlStockOHLC                 ' 股票圖
    
82.                           
    
83.          With .ChartGroups(1)
    
84.              .UpBars.Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
    
85.              .DownBars.Format.Fill.ForeColor.RGB = RGB(0, 32, 96)
    
86.         End With
    
87.         
    
88.         .SeriesCollection.Add Source:=Range("統計圖表!$G$1:統計圖表!$G$" & totalRows)
    
89.         .SeriesCollection(5).Name = "=統計圖表!$G$1"
    
90.         .SeriesCollection(5).ChartType = xlColumnClustered
    
91.         
    
92.         With .ChartGroups(2)      '注意, ChartGroup在插入成交量直條後變成 2 了
    
93.             .UpBars.Interior.Color = RGB(255, 0, 0)
    
94.             .DownBars.Interior.Color = RGB(0, 32, 96)
    
95.         End With
    
96.    
    
97.                              
    
98.         .Axes(xlCategory).CategoryType = xlCategoryScale
    
99.         .Axes(xlCategory).TickLabels.NumberFormatLocal = "hh:mm"
    
100.         .Axes(xlCategory).MajorTickMark = xlNone
     
101.         .Axes(xlCategory).TickLabelPosition = xlLow
     
102.             
     
103.         .Axes(xlValue).TickLabels.NumberFormatLocal = "0_ "                     ' 代表物件的格式代碼。
     
104.    
     
105.     End With
     
106. 
     
107.     xRow = 3
     
108.     yCol = 1
     
109.     cHeight = 460
     
110.     cWidth = 500
     
111.     inLeft = 30
     
112.     inTop = 30
     
113.     inWidth = 378
     
114. 
     
115.     text = "開盤價、最高價、最低價、收盤價"
     
116. 
     
117.     chartname = Trim(Replace(ActiveChart.Name, ActiveSheet.Name, ""))
     
118.     ActiveChart.ChartArea.Height = cHeight                           ' 將原本設定之高度調至適度位置
     
119.     ActiveChart.ChartArea.Width = cWidth
     
120.                
     
121.     ActiveSheet.Shapes(chartname).Left = Cells(xRow, yCol).Left     ' 設定此圖表實際擺放的 X、Y 座標位置。
     
122.     ActiveSheet.Shapes(chartname).Top = Cells(xRow, yCol).Top
     
123.       
     
124.     With ActiveChart.PlotArea                    ' 實際繪圖區塊的範圍設定
     
125.          .InsideLeft = inLeft
     
126.          .InsideTop = inTop
     
127.          .InsideWidth = inWidth
     
128.     End With
     
129.                
     
130.     ActiveChart.SetElement (msoElementChartTitleCenteredOverlay)
     
131.     ActiveChart.ChartTitle.text = text
     
132.     ActiveChart.ChartTitle.Format.TextFrame2.TextRange.Font.Size = 16
     
133.         
     
134.     ActiveChart.Legend.Position = xlCorner     ' 將圖表圖示從圖表最下方調整到圖表之右上角位置
     
135. End Sub

複製代碼

股票圖表.rar (23.42 KB)

下載次數: 52

2012-4-23 21:06

c_c_lai

回復 4# alexliou
可以將以下貼文全部Copy至一個 .csv 檔，然後再點選此檔案就可以直接進入到 Excel，
謝謝您的幫忙！

1. "日期","時間","開盤價","最高價","最低價","成交價","成交量","5MA","20MA","60MA"
   
2. 20120418,11:01,7155,7162,7154,7162,490,7153,7151,7158
   
3. 20120418,11:02,7162,7162,7158,7160,206,7155,7152,7158
   
4. 20120418,11:03,7160,7164,7160,7163,295,7157,7152,7158
   
5. 20120418,11:04,7163,7164,7159,7160,196,7160,7153,7158
   
6. 20120418,11:05,7160,7161,7158,7160,118,7161,7153,7158
   
7. 20120418,11:06,7160,7161,7157,7158,125,7160,7154,7158
   
8. 20120418,11:07,7158,7160,7157,7157,77,7160,7154,7158
   
9. 20120418,11:08,7157,7158,7156,7157,121,7158,7155,7158
   
10. 20120418,11:09,7157,7159,7157,7159,60,7158,7155,7157
    
11. 20120418,11:10,7159,7160,7158,7158,73,7158,7156,7157
    
12. 20120418,11:11,7158,7159,7157,7159,114,7158,7156,7157
    
13. 20120418,11:12,7159,7161,7158,7160,88,7159,7157,7157
    
14. 20120418,11:13,7160,7160,7155,7158,184,7159,7157,7156
    
15. 20120418,11:14,7158,7162,7158,7161,122,7159,7157,7156
    
16. 20120418,11:15,7161,7161,7155,7155,143,7159,7157,7156
    
17. 20120418,11:16,7155,7155,7148,7148,391,7156,7157,7156
    
18. 20120418,11:17,7148,7152,7148,7151,166,7155,7157,7155
    
19. 20120418,11:18,7151,7154,7151,7152,76,7153,7157,7155
    
20. 20120418,11:19,7152,7153,7147,7150,278,7151,7157,7155
    
21. 20120418,11:20,7150,7152,7148,7151,130,7150,7157,7155
    
22. 20120418,11:21,7152,7152,7149,7151,110,7151,7156,7154
    
23. 20120418,11:22,7151,7151,7148,7148,139,7150,7156,7154
    
24. 20120418,11:23,7148,7149,7145,7149,317,7150,7155,7154
    
25. 20120418,11:24,7149,7150,7147,7150,107,7150,7155,7154
    
26. 20120418,11:25,7150,7150,7144,7146,382,7149,7154,7154
    
27. 20120418,11:26,7146,7146,7133,7135,2139,7146,7153,7154
    
28. 20120418,11:27,7135,7136,7132,7132,511,7142,7152,7154
    
29. 20120418,11:28,7132,7135,7128,7133,850,7139,7150,7153
    
30. 20120418,11:29,7135,7137,7132,7134,318,7136,7149,7153
    
31. 20120418,11:30,7135,7135,7127,7127,396,7132,7148,7153

複製代碼

GBKEE

回復 6# c_c_lai
參考看看

圖表.rar (43.89 KB)

下載次數: 116

2012-4-24 15:32

c_c_lai

回復 7# GBKEE
再請教您：
(1) With Sheets("統計圖表")
            E = Application.Transpose(.Range(.[d1], .[d1].End(xlToRight)).Value)
    End With
    E 指的是 D1:H286 的範圍嗎？
(2) Ar 處裡的過程看得有點不甚瞭解，能否將過程稍加說明？ 因它又延伸到了 Rng(2) 的處理，
    尤其是 Rng(1).Columns(Application.Match(Ar(xi), Rng(1).Rows(1), 0)) 指的是甚麼？
(3) 我將 If .Name = 副座標 And .Parent.SeriesCollection.Count > 1 Then .AxisGroup = 2
    這段增修成：
    If .Name = 副座標 And .Parent.SeriesCollection.Count > 1 Then
        .AxisGroup = 2
        .ChartType = xlColumnClustered    (如附圖)
    End If
    為什麼加了 xlColumnClustered，
    ' .MarkerBackgroundColorIndex = xlNone
    ' .MarkerForegroundColorIndex = xlNone
    ' .Smooth = False  這三項都必須予以 Marked？
(4) 當圖表不存在時，程式 (制定資料區) 執行到 .ChartObjects.Delete 會產生
    "執行階段錯誤 '1004'"  應用程式或物件定義上的錯誤，則必須先行將它 Marked 起來，等產生後，
    再將它回復，接下來因已產生圖表，所以在按製圖 (不管幾百下) 當然也就 OK 了。
    請位在無圖表時，應如何去避免此錯誤發生？
(5) 最後當然不得不承認您的圖表產生較有技巧性 (如附圖之上下比對)，謝謝您的分享！

下載 (87.89 KB)

2012-4-24 17:59

alexliou

回復 5# c_c_lai
要增加5MA, 20MA, 50MA就和把成交量加上去一樣
可利用 SeriesCollection.Add 方法
假設5MA, 20MA, 50MA分別在H, I, J 欄

ActiveChart.SeriesCollection.Add Source:=Range("H2:J" & totalrows)
ActiveChart.SeriesCollection(6).ChartType = xlLine
ActiveChart.SeriesCollection(7).ChartType = xlLine
ActiveChart.SeriesCollection(8).ChartType = xlLine

資料序列6,7,8 (即5MA, 20MA, 50MA) 會與資料序列5(成交量)共用副座標軸
但5MA, 20MA, 50MA的刻度應與股價一致
所以需將副座標軸的刻度與主座標軸的刻度設為相同  
缺點是當成交量與股價的規模差太多時  
圖會看起來很奇怪 (所以成交量要取適當的單位, 讓它的值和股價不會差太多)
但我還找不出方法讓5MA, 20MA, 50MA與股價漲跌圖共用同一座標軸

GBKEE

回復 8# c_c_lai
(1)   E 指的是 D1 往右到最後有資料的範圍 ,  [d1].End(xlToRight)  如工作表上按下 Ctrl+-> 右方向鍵

(2)  Rng(1).Columns(Application.Match(Ar(xi), Rng(1).Rows(1), 0)) 指的是甚麼？   Rng(1).Columns(找到的欄)
Application.Match(Ar(xi), Rng(1).Rows(1), 0)->  工作表Match函數 在 Rng(1).Rows(1)-> Rng(1)的第一列  尋找 Ar(xi)

(3)   .ChartType = xlColumnClustered    有些屬性 並不是所有的圖形  都可以用的

(4) 當圖表不存在時，程式 (制定資料區) 執行到 .ChartObjects.Delete 會產生 "執行階段錯誤 '1004'"
2003版 不會有 是你的版本較嚴謹

(5) 捲軸 可縮短資料數, 直接打上數值也可以縮短資料數.