- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-3-24
|
29#
發表於 2024-1-19 09:42
| 只看該作者
本帖最後由 Andy2483 於 2024-1-19 10:02 編輯
回復 28# 藍天麗池
謝謝論壇,謝謝前輩耐心的等待,後學藉此帖學到很多知識,但不知道可不可行,我用兩個活頁簿之間的公式做測試每秒可以記錄300列,DDE沒用過,請前輩試試看,計算邏輯可能需要視需求調整,沒有研究這些計算的意義
使用的方法是只留[B1]裡有公式,這公式只是為了讓程式收到DDE變動值觸動 Private Sub Worksheet_Calculate() ,公式是所有DDE值相加的和而已 沒什麼意義 其他由VBA執行,字典key當變數,item當計算值
 變動記錄_20240119.zip (28.87 KB)
工作表模組:
Option Explicit
Private Sub Worksheet_Calculate()
Call Price
End Sub
一般模組:
Option Explicit
Public Z, BBS(1 To 5), BB(1 To 5), BA(1 To 5), BAS(1 To 5), FBS$, FAS$, E_2$, TT$, A(1 To 1, 1 To 5), j%
Sub Price()
If Not IsObject(Z) Then'一開始的[B1]公式建立
Set Z = CreateObject("Scripting.Dictionary")
BBS(1) = "=XQTISC|Quote!'FITXN*1.TF-BestBidSize1'"
BBS(2) = "=XQTISC|Quote!'FITXN*1.TF-BestBidSize2'"
BBS(3) = "=XQTISC|Quote!'FITXN*1.TF-BestBidSize3'"
BBS(4) = "=XQTISC|Quote!'FITXN*1.TF-BestBidSize4'"
BBS(5) = "=XQTISC|Quote!'FITXN*1.TF-BestBidSize5'"
BB(1) = "=XQTISC|Quote!'FITXN*1.TF-BestBid1'"
BB(2) = "=XQTISC|Quote!'FITXN*1.TF-BestBid2'"
BB(3) = "=XQTISC|Quote!'FITXN*1.TF-BestBid3'"
BB(4) = "=XQTISC|Quote!'FITXN*1.TF-BestBid4'"
BB(5) = "=XQTISC|Quote!'FITXN*1.TF-BestBid5'"
BA(1) = "=XQTISC|Quote!'FITXN*1.TF-BestAsk1'"
BA(2) = "=XQTISC|Quote!'FITXN*1.TF-BestAsk2'"
BA(3) = "=XQTISC|Quote!'FITXN*1.TF-BestAsk3'"
BA(4) = "=XQTISC|Quote!'FITXN*1.TF-BestAsk4'"
BA(5) = "=XQTISC|Quote!'FITXN*1.TF-BestAsk5'"
BAS(1) = "=XQTISC|Quote!'FITXN*1.TF-BestAskSize1'"
BAS(2) = "=XQTISC|Quote!'FITXN*1.TF-BestAskSize2'"
BAS(3) = "=XQTISC|Quote!'FITXN*1.TF-BestAskSize3'"
BAS(4) = "=XQTISC|Quote!'FITXN*1.TF-BestAskSize4'"
BAS(5) = "=XQTISC|Quote!'FITXN*1.TF-BestAskSize5'"
FBS = "=XQTISC|Quote!'FITXN*1.TF-FiveBidSize'"
FAS = "=XQTISC|Quote!'FITXN*1.TF-FiveAskSize'"
E_2 = "=VALUE(HOUR(NOW())&IF(LEN(MINUTE(NOW()))=1,0&MINUTE(NOW()),MINUTE(NOW()))&IF(LEN(SECOND(NOW()))=1,0&SECOND(NOW()),SECOND(NOW())))"
TT = "=(" & Mid(FBS, 2) & "+" & Mid(FAS, 2)
For j = 1 To 5
TT = TT & "+" & Mid(BBS(j), 2) & "+" & Mid(BB(j), 2) & "+" & Mid(BA(j), 2) & "+" & Mid(BAS(j), 2)
Next
TT = TT & ")"
ThisWorkbook.Sheets(1).[B1] = TT
End If
'=================================================================================
'以下是以字典key計算DDE值
Z("J5") = Evaluate(BBS(1)): Z("J6") = Evaluate(BBS(2)): Z("J7") = Evaluate(BBS(3)): Z("J8") = Evaluate(BBS(4)): Z("J9") = Evaluate(BBS(5))
Z("K5") = Evaluate(BB(1)): Z("K6") = Evaluate(BB(2)): Z("K7") = Evaluate(BB(3)): Z("K8") = Evaluate(BB(4)): Z("K9") = Evaluate(BB(5))
Z("L5") = Evaluate(BA(1)): Z("L6") = Evaluate(BA(2)): Z("L7") = Evaluate(BA(3)): Z("L8") = Evaluate(BA(4)): Z("L9") = Evaluate(BA(5))
Z("M5") = Evaluate(BAS(1)): Z("M6") = Evaluate(BAS(2)): Z("M7") = Evaluate(BAS(3)): Z("M8") = Evaluate(BAS(4)): Z("M9") = Evaluate(BAS(5))
Z("K10") = Evaluate(FBS): Z("L10") = Evaluate(FAS)
'以下是計算,應該很眼熟,只是把儲存格置換成key而已
Z("K12") = Z("K10") + Z("L10")
If Z("K12") <> Z("L12") Then
Z("I14") = 0
If Z("K14") = Z("K5") Then
Z("I14") = Z("J5") - Z("J14")
ElseIf Z("K14") = Z("K6") Then
Z("I15") = Z("J6") - Z("J14")
End If
Z("I15") = 0
If Z("K15") = Z("K5") Then
Z("I15") = Z("J5") - Z("J15")
ElseIf Z("K15") = Z("K6") Then
Z("I15") = Z("J6") - Z("J15")
ElseIf Z("K15") = Z("K7") Then
Z("I15") = Z("J7") - Z("J15")
End If
Z("I16") = 0
If Z("K16") = Z("K6") Then
Z("I16") = Z("J6") - Z("J16")
ElseIf Z("K16") = Z("K7") Then
Z("I16") = Z("J7") - Z("J16")
ElseIf Z("K16") = Z("K8") Then
Z("I16") = Z("J8") - Z("J16")
End If
Z("I17") = 0
If Z("K17") = Z("K7") Then
Z("I17") = Z("J7") - Z("J17")
ElseIf Z("K17") = Z("K8") Then
Z("I17") = Z("J8") - Z("J17")
ElseIf Z("K17") = Z("K9") Then
Z("I17") = Z("J9") - Z("J17")
End If
Z("I18") = 0
If Z("K18") = Z("K8") Then
Z("I18") = Z("J8") - Z("J18")
ElseIf Z("K18") = Z("K9") Then
Z("I18") = Z("J9") - Z("J18")
End If
Z("N14") = 0
If Z("L14") = Z("L5") Then
Z("N14") = Z("M5") - Z("M14")
ElseIf Z("L14") = Z("L6") Then
Z("N14") = Z("M6") - Z("M14")
End If
Z("N15") = 0
If Z("L15") = Z("L5") Then
Z("N15") = Z("M5") - Z("M15")
ElseIf Z("L15") = Z("L6") Then
Z("N15") = Z("M6") - Z("M15")
ElseIf Z("L15") = Z("L7") Then
Z("N15") = Z("M7") - Z("M15")
End If
Z("N16") = 0
If Z("L16") = Z("L6") Then
Z("N16") = Z("M6") - Z("M16")
ElseIf Z("L16") = Z("L7") Then
Z("N16") = Z("M7") - Z("M16")
ElseIf Z("L16") = Z("L8") Then
Z("N16") = Z("M8") - Z("M16")
End If
Z("N17") = 0
If Z("L17") = Z("L7") Then
Z("N17") = Z("M7") - Z("M17")
ElseIf Z("L17") = Z("L8") Then
Z("N17") = Z("M8") - Z("M17")
ElseIf Z("L17") = Z("L9") Then
Z("N17") = Z("M9") - Z("M17")
End If
Z("N18") = 0
If Z("L18") = Z("L8") Then
Z("N18") = Z("M8") - Z("M18")
ElseIf Z("L18") = Z("L9") Then
Z("N18") = Z("M9") - Z("M18")
End If
'以下是 [J14:M19] = [J5:M10].Value 以字典方式轉換
Z("J14") = Z("J5"): Z("J15") = Z("J6"): Z("J16") = Z("J7"): Z("J17") = Z("J8"): Z("J18") = Z("J9"): Z("J19") = Z("J10")
Z("L14") = Z("L5"): Z("L15") = Z("L6"): Z("L16") = Z("L7"): Z("L17") = Z("L8"): Z("L18") = Z("L9"): Z("L19") = Z("L10")
Z("M14") = Z("M5"): Z("M15") = Z("M6"): Z("M16") = Z("M7"): Z("M17") = Z("M8"): Z("M18") = Z("M9"): Z("M19") = Z("M10")
End If
'以下是 將計算值帶入A陣列並寫入儲存格
Z("L12") = Z("K19") + Z("L19")
Z("A2") = Format(Now, "HH:MM:SS")
Z("B2") = Z("I14") + Z("I15") + Z("I16") + Z("I17") + Z("I18")
Z("C2") = Z("N14") + Z("N15") + Z("N16") + Z("N17") + Z("N18")
Z("D2") = Z("K10") + Z("L10")
Z("E2") = Evaluate(E_2)
A(1, 1) = Z("A2"): A(1, 2) = Z("B2"): A(1, 3) = Z("C2"): A(1, 4) = Z("D2"): A(1, 5) = Z("E2")
ThisWorkbook.Sheets(1).Cells(Rows.Count, "A").End(3)(2).Resize(, 5) = A
Application.EnableEvents = True
End Sub
Sub 清除()
[A3].Resize(1000000, 5).ClearContents: ActiveWindow.ScrollRow = 1
End Sub
Sub 自動重算()
Application.Calculation = xlAutomatic
End Sub
Sub 手動重算()
Application.Calculation = xlManual
End Sub |
|
