 
字體：小 中 大 |
|
|
|
| 2022/02/11 13:19:40瀏覽5928｜回應2｜推薦3 | |
2022.8.18 註記：由於 Excel 執行環境改變，這個程式不得不進行大改，敬請期待。
自從提供抄錄 DDE/RTD 傳入資料的 VBA 程式碼後，有些讀者來信要求提供或示範把單一交易日的成交價量資料彙整成為畫 K 線所需的數據。記得曾經簡單地寫過一個範例給某位讀者，去年聖誕節前又有位讀者來信提起，想一想，好吧！就利用今年(2022)初較多假期來再寫一遍。 這個版本是基於「抄錄 DDE OnCalculate 之預約開關版」( ←參閱部落格文章，請點連結)，增加「盤後K線」功能，將抄錄下來的 (在 Record 工作表中) 資料，按照指定的時間間隔，整理成 "N 分鐘 K 線" 資料 (到 KLineData 工作表中) 、畫出 K線圖表(chart)。
[功能與用法]
首先，需使用抄錄功能將 DDE 或 RTD 傳來的成交價量資料抄錄在 Record 工作表中，欄位的安排如圖1：(K 線會使用到 B, C, F 欄)
這版本可以畫出 1-90 分鐘 K 線，例如想要畫 30分鐘 K 線圖，就在 Control 工作表的 B9 儲存格裡輸入 30 (如下圖)，然後按它左邊的按鈕，片刻之後，畫面會顯示資料整理完成的訊息：
整理好的 K 線資料會在 KLineData 工作表中，事實上，我在 KLineData 工作表預先做了一個 K 線圖 (使用 Excel 的 "插入"→"圖表" 功能)，VBA 程式會將這圖表的標題改成 「30分鐘 K 線圖」，以整理好的資料為 K 線的數列資料：
你可以把 KLineData 工作表複製保留起來。重新統計之前，必須先將舊資料清除，所以每當按下「盤後統計 K 線資料」鈕的時候，程式首先會檢查 KLineData 工作表裡是否有整理好的資料，若有，便會顯示訊息詢問你是否允許它清除?
此時若按 "取消"，程式將不清除舊資料，也就不執行統計。
在 Control 工作表可以看到我順便做了一個清除K線舊資料的按鈕，舊資料清除完畢，它會顯示訊息：
如果沒有資料，它會顯示訊息說目標範圍沒有資料:
[Excel 的 K 線圖(股票圖)] 這裡先簡單介紹 Excel 的 K 線圖(股票圖)。K線在英文中稱為 Candlestick chart 也就是 "蠟燭線"，可以將一個時段内成交價的變化: 開盤、收盤、最高、最低價，以及成交量，呈現在一個圖形中。這種圖之所以被我們稱為 "K" 線，據說是起源於日語稱呼的發音 (請參閱維基百科)。在 Excel 中則稱這種線圖為 "股票圖"。使用 "插入圖表" 功能，可以看到它提供了幾種形態的 "股票圖"。目前的 Office 365 提供如下圖的四種選擇：
像本文前面那個 "30分鐘 K 線圖" 的樣子，我是選擇最右邊那種，所以我的資料欄位由左至右排列順序要是: 成交量-開盤-最高-最低-收盤，而且要把 "時段" 放在左邊。插入圖表之前，要先像下圖這樣，用滑鼠指標選取這 6 個欄位 (選取範圍呈現反白)：(在還沒有資料的情況下，你可以先隨便打幾列資料)
選用這種 K 線圖(目前版本)，它會把下跌線 (收盤價低於開盤價) 畫成黑色，把上漲線 (收盤價高於開盤價) 畫成白色。台灣和中國大陸、日、韓的習慣是 "紅漲綠跌"(請參閱維基百科，我在歐美網站查看 NYSE 是 "綠漲紅跌")，我們可以點選上漲的 K 線和下跌的 K 線，分別設定填滿的顏色 (也可以用漸層、圖樣......等等)：
[程式原理] 在我的這個版本檔案裡，把 K 線相關的程式碼全部寫在 "KLINE" 模組裡 (原先的 module1 裡是 "抄錄" 相關的程式)。裡面包括：
本文的重點在彙整 K 線資料，以下說明 BtnAggregate_Click() 這個副程式。 在 BtnAggregate_Click() 裡面，我使用 bGo 這個邏輯變數來控制程式的流程，由上至下，大致可以分為 5 大階段（步驟）：
【決定時段】 首先，判斷若成交(報價)時間早於上午 9 時正(TSE 開盤)，一律視為第一個時段也就是 "09:00:00 AM" 的那個時段，因此把 iKLineRow 的值設為 "2"(KLineData 第一列是標題)。 其次，利用 VBA 的 DateDiff() 函式計算出 "成交(報價)時間"距離開盤時間 ("09:00:00 AM") 有幾分鐘？(參數 "n" 代表要計算的是相差多少 "分"，參閱 VBA Language reference DateDiff function )。然後將這個數值除以變數 IntervalMins 的值, 此值為使用者輸入的 "時段間隔時間" (1-90分鐘)，基本上，這個除法得到的 "商" 就是這一筆成交價要歸入哪個時段，但是不會每個數都剛好整除 (除非時段間隔時間為 1 分鐘)，所以這裡利用 Excel 工作表函數 RoundDown 來做無條件捨去，我給這個函數第二個參數 "0" 是要它無條件捨去到整數的意思。(參閱 WorksheetFunction.RoundDown method (Excel) ) 然後要把這個數值 +2 ，再設給 iKLineRow 變數 (因為第一列是標題)。 【時段的開、高、低、收】 時段開始價：若是新的一列，則以此筆記錄的時間為此時段的開始價。使用變數iLastKLineRow 記著 "前一次" 的 iKLineRow 變數值，所以當 iKLineRow 與 iLastKLineRow 不相等的時候，就是換了一列，也就是換了一個時段。 時段最高價：若此時段目前無最高價，或目前的最高價低於此筆成交價，則以此筆成交價為此時段最高價。 時段最低價：若此時段目前無最低價，或目前的最低價高於此筆成交價，則以此筆成交價為此時段最低價。 時段最後價 (此時段的收盤價): 直接以此筆成交價為此時段最後成交價。 【時段成交量】 時段成交量是累加的，也就是把 Worksheets("Record").Cells(iCurrentRecordRow, 6) 值和 Worksheets("KLineData").Cells(iKLineRow, VolumeCol) 的值相加，存回 Worksheets("KLineData").Cells(iKLineRow, VolumeCol)
[程式碼(文字)] ※註1：因單引號 (single-quote) 有時會被 UDN 部落格誤認為 HTML，以下程式碼中的註解一律寫成 Rem。
※註2：請注意程式列右端的底線 (undercore) 是 "此句未完，下一列繼續" 的意思，不可省略，除非把下一列接上來。 [常數定義] Rem 所有變數必須明確宣告
Option Explicit
Rem KLineData 的欄位 (配合 Excel K 線圖所需的順序)
Public Const QTimeCol = 1
Rem A 欄：時段時間
Public Const VolumeCol = 2
Rem B 欄：時段成交量(張數)
Public Const StartCol = 3
Rem C 欄：時段開始價
Public Const HighCol = 4
Rem D 欄：時段最高價
Public Const LowCol = 5
Rem E 欄：時段最低價
Public Const EndCol = 6
Rem F 欄：時段收盤價
Rem 限定 (K 線) 間隔分鐘設定的最小值/最大值
Public Const MinMinutes = 1
Public Const MaxMinutes = 90
[函式(公用常式)]
Public Function IsInt(aValue As Variant) As Boolean
Rem 判斷傳入的變動型別資料是否為整數，傳回值: True 真或 False 假 IsInt = (CInt(aValue) = aValue) Public Function iClearK() As Integer
Rem 清除 (KLineData頁) 的 K 線資料，傳回值：
Rem 0: 目標範圍沒有資料
Rem 1: 目標範圍清除完畢
Rem 2: 清除工作已取消
Dim lEndRow As Long
Rem 最底下一列的列號
With Worksheets("KLineData")
lEndRow = WorksheetFunction.Max(.Range(Chr(64 + QTimeCol) & 65535).End(xlUp).Row, _
.Range(Chr(64 + VolumeCol) & 65535).End(xlUp).Row, _
.Range(Chr(64 + StartCol) & 65535).End(xlUp).Row, _
.Range(Chr(64 + HighCol) & 65535).End(xlUp).Row, _
.Range(Chr(64 + LowCol) & 65535).End(xlUp).Row, _
.Range(Chr(64 + EndCol) & 65535).End(xlUp).Row)
Rem 取得各欄最底下一列的列號
Rem 或這樣寫: lEndRow = .Range(Chr(64 + QTimeCol) & 65535 & ":" & Chr(64 + EndCol) _
Rem & 65535).End(xlUp).Row
If lEndRow < 2 Then
iClearK = 0
Rem 目標範圍沒有資料
ElseIf MsgBox("K線資料 [KLineData!" & Chr(64 + QTimeCol) & "2:" & Chr(64 + EndCol) _
& lEndRow & "]" & " 將被清除，確定嗎?", vbOKCancel, "清除K線舊資料") _
= vbOK Then
.Range(Chr(64 + QTimeCol) & "2:" & Chr(64 + EndCol) & lEndRow).Clear
iClearK = 1
Rem 目標範圍清除完畢
Else
iClearK = 2
Rem 清除工作已取消
End If
End With
End Function
[清除舊資料]
Sub BtnClear_Click()
Rem 按鈕清除 (KLineData頁) 的 K 線資料
Dim sTitle As String
sTitle = "清除K線舊資料"
Select Case iClearK
Rem 叫用 iClearK() 函式
Case 0:
MsgBox "目標範圍 [KLineData!" & Chr(64 + QTimeCol) & ":" & Chr(64 + EndCol) & "] _
裡沒有資料", Title:=sTitle
Case 1:
MsgBox "目標範圍 [KLineData!" & Chr(64 + QTimeCol) & ":" & Chr(64 + EndCol) & "] _
裡資料已清除完畢", vbOKOnly, Title:=sTitle
Case 2:
MsgBox "清除工作已取消", vbOKOnly, Title:=sTitle
End Select
End Sub
[彙整 K 線資料]
Sub BtnAggregate_Click()
Rem 將 (Record 頁) 記錄資料彙整為 (KLineData頁) 畫 K 線所需的資料
Ｄim lRecordEndRow As Long
Rem 記錄最底下一列的列號
Dim lKLineEndRow As Long
Rem K線資料最底下一列的列號
Dim iCurrentRecordRow As Integer
Rem 正在處理的記錄列號
Dim iLastKLineRow As Integer
Rem 前一次寫入的 K 線時段資料列
Dim iKLineRow As Integer
Rem 現在要寫入的 K 線時段資料列
Dim dDealPrice As Double
Rem 成交價
Dim IntervalMins As Integer
Rem 時段間隔分鐘數
Dim bGo As Boolean
Rem 依此值決定是否繼續執行
Dim sMsg, sTitle As String
Rem 訊息文字和訊息框的標題
Rem MsgBox(Prompt, Buttons, Title, Help, Ctxt)
sTitle = "K線統計"
iCurrentRecordRow = 2
Rem 從記錄資料第2列開始處理
iLastKLineRow = 0
Rem 最近一次寫入的 K 線資料列-->歸零
Rem Step 1:
Rem 需確認 Record 裡有記錄資料
lRecordEndRow = Worksheets("Record").Range("B65535:G65535").End(xlUp).Row
Rem 找到記錄的最末列
If lRecordEndRow < 2 Then sMsg = "無法彙整！Record 工作表裡似乎沒有記錄資料。"
MsgBox sMsg, Buttons:=vbCritical, Title:=sTitle
bGo = False
Else
bGo = True
End If
Rem Step 2:
Rem 決定要彙整幾分鐘 K 線(決定間隔時間)
If bGo Then
If Worksheets("Control").Cells(9, 2) < MinMinutes Or _
Worksheets("Control").Cells(9, 2) > MaxMinutes Or _
Not IsInt(Worksheets("Control").Cells(9, 2)) Then
sMsg = "請輸入 " & MinMinutes & " - " & MaxMinutes & " 之間的整數"
MsgBox sMsg, Buttons:=vbCritical, Title:=sTitle
bGo = False
Else
IntervalMins = Worksheets("Control").Cells(9, 2)
sTitle = IntervalMins & " 分鐘 K 線彙整"
bGo = True
End If
End If
Rem Step 3:
Rem 清除 (KLineData頁) 的 K 線資料
If bGo Then
Select Case iClearK
Case 0: bGo =True
Case 1: bGo =True
Case 2:
sMsg = "清除舊資料的工作已取消，將不進行資料彙整！"
MsgBox sMsg, Buttons:=vbCritical, Title:=sTitle
bGo = False
End Select
End If
Rem Step 4:
Rem 逐列讀入 Record 資料表中的數據，依 "報價時間" 決定它屬哪個時間區段，
Rem 然後判斷並以它的值來更新 KLineData 那個時段的量、開、高、低、收各欄
Do While bGo And iCurrentRecordRow < = lRecordEndRow
If Worksheets("Record").Cells(iCurrentRecordRow, 2) < TimeValue("09:00:00 AM") Then
iKLineRow = 2
Rem 9:00:00 以前的視為第一個時段資料
Else
iKLineRow = Application.WorksheetFunction.RoundDown(DateDiff("n", TimeValue_
("09:00:00 AM"), Worksheets("Record").Cells(iCurrentRecordRow, 2)) _
/ IntervalMins, 0) + 2
End If
dDealPrice = Worksheets("Record").Cells(iCurrentRecordRow, 3)
Rem 取記錄的成交價 (欄位為 C 欄)
Rem 時段開始價 (此時段的開盤價)
If iLastKLineRow <> iKLineRow Then
Worksheets("KLineData").Cells(iKLineRow, QTimeCol) = _
Format(Worksheets("Record").Cells(iCurrentRecordRow, 2), "Long Time")
Rem 若是新的一列，以此筆記錄的時間為此時段的開始價
Worksheets("KLineData").Cells(iKLineRow, StartCol) = dDealPrice
iLastKLineRow = iKLineRow
End If
Rem 時段最高價：若此時段目前無最高價，或目前的最高價小於此筆成交價，則以此筆成交價為此時段最高價
If Worksheets("KLineData").Cells(iKLineRow, HighCol) = "" Or _
Worksheets("KLineData").Cells(iKLineRow, HighCol) < dDealPrice Then
Worksheets("KLineData").Cells(iKLineRow, HighCol) = dDealPrice
End If
Rem 時段最低價：若此時段目前無最低價，或目前的最低價大於此筆成交價，則以此筆成交價為此時段最低價
If Worksheets("KLineData").Cells(iKLineRow, LowCol) = "" Or _
Worksheets("KLineData").Cells(iKLineRow, LowCol) > dDealPrice Then
Worksheets("KLineData").Cells(iKLineRow, LowCol) = dDealPrice
End If
Rem 時段最後成交價 (時段收盤價): 直接以此筆成交價為此時段最後成交價
Worksheets("KLineData").Cells(iKLineRow, EndCol) = dDealPrice
Rem 時段成交單量(累加)
Worksheets("KLineData").Cells(iKLineRow, VolumeCol) = _
Worksheets("KLineData").Cells(iKLineRow, VolumeCol) + _
Worksheets("Record").Cells(iCurrentRecordRow, 6)
Rem Record 換列
iCurrentRecordRow = iCurrentRecordRow + 1
Loop
Rem Step 5: 更新 K 線圖 If bGo Then
With Worksheets("KLineData").ChartObjects(1).Chart
.HasTitle = True
.ChartTitle.Text = IntervalMins & " 分鐘 K 線圖"
Rem 重設圖表標題
.SetSourceData Source:=Worksheets("KLineData").Range(Chr(64 + QTimeCol) & "1:" & _
Chr(64 + EndCol) & Format(iKLineRow))
Rem 重設圖表資料範圍
End With
sMsg = iCurrentRecordRow - 2 & " 筆記錄已彙整為 " & iLastKLineRow - 1 & " 個時段"
MsgBox Prompt:=sMsg, Buttons:=vbOKOnly, Title:=sTitle
End If
End Sub
[程式碼(截圖)]
[末記] 近期大多僅能利用假日編寫測式程式，因此不便做盤中即時 K 線，只能寫這個盤後版。感謝讀者吳鈴山提供他抄錄 TSE 某個股的一日成交資料，特此銘謝！讀者若需這個 .xls 檔，歡迎 email 寄 way2cheng@gmail.com 主旨寫：「我要 OnCalculate 的盤後 K 線版」即可。(每封 email 請只索取一個檔案，謝謝!) 留言可能需等很久很久才會被發現，若有疑問請 email 給我 相關文章： [Excel VBA] 記錄 DDE 傳入的 (每個) tick (利用 OnCalculate 事件) |
|
| ( 知識學習｜其他 ) |
