網路城邦
上一篇 回創作列表 下一篇   字體:
[Excel VBA] 盤後彙整 N 分鐘 K 線 (利用抄錄到的成交價量資料)即將改版!
2022/02/11 13:19:40瀏覽1250|回應0|推薦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 裡是 "抄錄" 相關的程式)。裡面包括:

  • BtnAggregate_Click() 是 "盤後彙整 K 線資料" 按鈕執行的副程式。
  • IsInt() 是 BtnAggregate_Click() 裡用來判斷使用者輸入的 "幾分鐘" 是否為整數
  • BtnClear_Click() 是 "清除舊 K 線資料" 按鈕執行的副程式。
  • iClearK() 是用來清除 (KLineData工作表) 的 K 線資料,在 BtnAggregate_Click() 和 BtnClear_Click() 裡面都會使用它。這個函式的主要工作是判斷 KLineData 工作表K 線資料的那幾個欄位裡面現在有沒有資料,若有資料,就把那個範圍的儲存格內容清除。

本文的重點在彙整 K 線資料,以下說明 BtnAggregate_Click() 這個副程式。 在 BtnAggregate_Click() 裡面,我使用 bGo 這個邏輯變數來控制程式的流程,由上至下,大致可以分為 5 大階段(步驟):

  • Step 0: 宣告變數,設定初始值。
    在模組開頭寫了 "Option Explicit" 陳述,VBA 解譯器會檢查,名稱一定要先經過宣告,可避免打錯變數名稱或在有效範圍內相同的變數名稱。

  • Step 1: 確認 Record 工作表裡有記錄資料。用 Range 的 .End(xlUp).Row 取得 B-G 欄最底下一列資料的列號,若結果小於 2 (第一列是標題),則表示沒有記錄資料。

  • Step 2: 決定要統計幾分鐘 K 線,也就是決定時段的間隔時間。
    取得 Control 工作表 9 列 B 欄儲存格裡的資料,先確認它必須是一個 1~90之間的 "整數"。模組開頭有定義兩個常數: MinMinutes = 1, MaxMinutes = 90
  • Step 3: 清除 KLineData工作表裡的 K 線舊資料。
    判斷 iClearK 函式的傳回值,若為 0(無資料) 或 1(成功清除),則程式可繼續進行。

  • Step 4: 逐列讀入 Record 資料表中的數據,依 "報價時間" 決定它屬哪個時間區段,然後判斷並以它的值來更新 KLineData 那個時段的量、開、高、低、收各欄。

    我們在 Record 工作表的 B 欄 (第 2 欄) 記錄的是 DDE/RTD 傳來的成交時間,也就是說,成交(報價)時間是在 Worksheets("Record").Cells(iCurrentRecordRow, 2)。

【決定時段】

首先,判斷若成交(報價)時間早於上午 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) 

  • Step 5: 更新 K 線圖。
    最後,對預先插入在工作表上的 K 線圖 chart 做兩個變動:1.更改它的標題;2.1.更改它的資料範圍,把彙整好的 K 線資料範圍傳給 .setSourceData 方法。請參閱 Microsoft Office VBA 文件關於 chart 物件 https://docs.microsoft.com/zh-tw/office/vba/api/excel.chart(object) (.setSourceData 方法和 .HasTitle 屬性與 .ChartTitle.Text 屬性)  

 [程式碼(文字)]

※註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 假  
On Error Resume Next

IsInt = (CInt(aValue) = aValue)
On Error GoTo 0
End Function

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 線所需的資料
Dim 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 請只索取一個檔案,謝謝!)
*Note

留言可能需等很久很久才會被發現,若有疑問請 email 給我 
way2cheng@gmail.com (但每天只看一次信箱

相關文章:
[Excel VBA] 抄錄 DDE OnCalculate 之預約開關版

[Excel VBA] 固定間隔時間記錄DDE傳入的資料

[Excel VBA] 記錄 DDE 傳入的 (每個) tick

[Excel VBA]如何把個股每5分鐘的成交價格記錄下來?

( 知識學習其他 )
回應 推薦文章 列印 加入我的文摘
上一篇 回創作列表 下一篇

引用
引用網址:https://classic-blog.udn.com/article/trackback.jsp?uid=WayCheng&aid=171415663