123
返回列表 上一主題 發帖

[發問] API逐筆運算負擔大，可否精簡

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2018-10-13 02:39 | 顯示全部帖子

[發問] API逐筆運算負擔大，可否精簡

各位大大，小弟最近初學VBA，試著土法煉鋼把想要的方式改用VBA操作，巨集雖可以使用，但程式的負荷很重，是否有辦法精簡呢
採用的是API期貨報價，進行逐筆運算(範例的筆數很少，實際情況將隨時間變成幾萬筆資料)，並將B欄的成交時間複製到Sht1.Range("C1")

接著依照Sht1.Range("C1")的時間，將運算的結果(Sht2.Cells(4, "J")與Sht2.Cells(5, "J"))   貼在Sht3的B.C欄
每
  1. Sub 多空紀錄()
  2. Call 共用參照 '測試用

  4. If Sht1.Range("C1") >= TimeValue("08:45:00") And Sht1.Range("C1") < TimeValue("08:50:00") Then
  5. Sht3.Cells(2, "B") = Sht2.Cells(4, "J")
  6. Sht3.Cells(2, "C") = Sht2.Cells(5, "J")
  7. End If

  9. If Sht1.Range("C1") >= TimeValue("08:50:00") And Sht1.Range("C1") < TimeValue("08:55:00") Then
  10. Sht3.Cells(3, "B") = Sht2.Cells(4, "J")
  11. Sht3.Cells(3, "C") = Sht2.Cells(5, "J")
  12. End If
  13. If Sht1.Range("C1") >= TimeValue("08:55:00") And Sht1.Range("C1") < TimeValue("09:00:00") Then
  14. Sht3.Cells(4, "B") = Sht2.Cells(4, "J")
  15. Sht3.Cells(4, "C") = Sht2.Cells(5, "J")
  16. End If
  17. If Sht1.Range("C1") >= TimeValue("09:00:00") And Sht1.Range("C1") < TimeValue("09:05:00") Then
  18. Sht3.Cells(5, "B") = Sht2.Cells(4, "J")
  19. Sht3.Cells(5, "C") = Sht2.Cells(5, "J")
複製代碼
如以上程式每5分鐘一個區間，一直記錄到13:45為止，
由於現在是每一筆成交就進行一次運算，1秒內可能成交很多筆交易，
有想過是否可以改為1秒進行一次紀錄就好，
再麻煩各位高手幫忙，謝謝！

依時間紀錄.rar (16.85 KB)

收藏 分享

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
2#
發表於 2018-10-13 11:45 | 顯示全部帖子
回復 2# GBKEE
謝謝超版G大的協助
試運行了程式，發現會連報價運算的部分都變成1秒計算一次，
而多空紀錄似乎是以電腦時間來做紀錄，

因為小弟初學VBA，不確定是否有可能實現，
讓Sub 報價運算()的部分以正常速度運行，但Sub 多空紀錄()以程式的時間進行1秒1次(或是加條件新時間>舊時間)再判斷時間條件後記錄呢

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
3#
發表於 2018-10-13 19:12 | 顯示全部帖子
回復 4# GBKEE
謝謝G大 原本遇到一些問題，
研究了一下，紀錄的部分都解決了！
謝謝！

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
4#
發表於 2018-10-14 17:22 | 顯示全部帖子
回復 4# GBKEE
不好意思，再另做一個紀錄15分K開高低收的巨集上遇到了困難(由於這跟原標題不完全符合，若需另主題再麻煩告知)
希望在原本逐筆計算的過程中，將每15分鐘的開高低收價格紀錄起來，運用o,h,l,c 四個變數
請問要如何在每15分鐘紀錄那邊，要換行紀錄時才將o,h,l變數歸0並重新計算呢
  1. Option Explicit
  2. Public uMode&, StartTime, EndTime
  3. Public MyBook As Workbook, Sht1 As Worksheet, Sht2 As Worksheet, Sht3 As Worksheet, xRow&
  4. Public o As Single, h As Single, l As Single c As Single

  6. Sub 共用參照()
  7.     Set MyBook = ThisWorkbook
  8.     Set Sht1 = MyBook.Sheets("多空藍圖")
  9.     Set Sht2 = MyBook.Sheets("報價數據")
  10.     Set Sht3 = MyBook.Sheets("多空數據")
  11.     StartTime = "08:44:50"  '開盤時間（提早十秒開始，才可記錄開盤量價）
  12. End Sub
  13. Sub 報價運算()
  14.     Dim xTime As Date
  15.     Dim i As Long
  16.    
  17.     Call 共用參照 '測試用
  18.     If Sht2.Range("H2") <> 1 Then '開盤條件
  19.         Sht2.Range("J2,J4,J5").ClearContents '清除紀錄資料
  20.         Sht2.Range("K2") = Sht2.Range("I2") '判斷價改為開盤價
  21.     End If
  22.     i = 1
  23.    
  24.     Do
  25.         i = i + 1
  26.         
  27.         If Sht2.Cells(2, "J") = "↑" And Sht2.Cells(i, "H") <> 1 Then '多方加總
  28.             Sht2.Range("J4") = Sht2.Range("J4") + Sht2.Range("D" & i)
  29.         End If
  30.         If Sht2.Cells(2, "J") = "↓" And Sht2.Cells(i, "H") <> 1 Then '空方加總
  31.             Sht2.Range("J5") = Sht2.Range("J5") + Sht2.Range("D" & i)
  32.         End If
  33.         If Sht2.Cells(i, "H") <> 1 Then
  34.             Sht1.Cells(1, "C") = Sht2.Range("B" & i) '報價時間傳送到多空藍圖
  35.         End If

  37. '***以下新增15分K紀錄
  38. c = Sht2.Range("C" & i)
  39.    If c > h Then h = c '更新最高價
  40.    If c < l Then l = c '更新最低價
  41.    If o = 0 Then o = Sht2.Range("C" & i) Else o = o
  42.    If l = 0 Then l = Sht2.Range("C" & i) Else l = l
  43.    If h = 0 Then h = Sht2.Range("C" & i) Else h = h
  44. Sht2.Range("O2").Value = o '填開盤價
  45. Sht2.Range("P2").Value = h '填最高價
  46. Sht2.Range("Q2").Value = l '填最低價
  47. Sht2.Range("R2").Value = c '填收盤價
  48.         
  49.         If Sht1.Range("C1") > xTime Then  '** 一秒運行一次    **
  50.             
  51.             Call 多空紀錄
  52.             Call 分K開高低收
  53.         End If
  54.         

  56.         Sht2.Cells(i, "H") = 1 '運算過的進行標記避免重複運算
  57.     Loop Until Sht2.Range("C" & i + 1) = 0 '迴圈停止條件
  58. End Sub

  60. Sub 分K開高低收()
  61. Call 共用參照 '測試用

  63.   Dim xMinute As Integer
  64.    
  65.         
  66.         xMinute = Int(Application.Text(Sht1.Range("C1") - #8:45:00 AM#, "[M]") / 15)
  67.         '*** xMinute 以 Time 距 8:45 的分鐘數 / 15 傳回的整數
  68.         '*** Time 小於 8:45 得到負數
  69.         If xMinute > -1 And Sht1.Range("C1") <= #1:45:00 PM# Then
  70.             xMinute = xMinute + 3   '*** 從第2列開始
  71.             Sht2.Cells(xMinute, "O") = Sht2.Cells(2, "O")
  72.             Sht2.Cells(xMinute, "P") = Sht2.Cells(2, "P")
  73.             Sht2.Cells(xMinute, "Q") = Sht2.Cells(2, "Q")
  74.             Sht2.Cells(xMinute, "R") = Sht2.Cells(2, "R")
  75.         End If
  76.       
  77. End Sub
複製代碼

15分K紀錄.rar (19.87 KB)

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
5#
發表於 2018-10-15 20:35 | 顯示全部帖子
回復 7# GBKEE
謝謝超版G大，明天盤中測試看看，
雖然說這次的程式對我實在太深奧了，
還有好長的一條路，我會努力學習的！

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
6#
發表於 2018-10-16 10:36 | 顯示全部帖子
回復 7# GBKEE
早安G大，因為這次的程式，小弟慢慢查MSDN一些程式的含意仍然不甚了解，我大概描述一下使用上的問題，再請您多多指導，
一開始照著說明存檔後重開(您提供的原檔)，沒有任何反應，也覺得很奇怪這樣沒報價的數據怎麼運算呢，
接著觀察到以下代碼，
  1. Set Rng = Sheets("多空藍圖").Range("A2") '** 指數 代號
複製代碼
並將Sheets("多空藍圖").Range("A2")填上代碼後存檔重開，即新創了一個試算表，試算表名稱為指數的代號，
其試算表也跑出
  1. Names.Add "Ar", Array("1分", "5分", "10分", "15分", "20分", "30分", "60分")
複製代碼
等各項欄位名稱，但因為沒有報價數據，所以並沒有在運算，
接下來我把程式貼到我原本的檔案，並將
  1. Set Rng = Sheets("多空藍圖").Range("A2") '** 指數 代號
複製代碼
改成我原本的報價區域
  1. Set Rng = Sheets("報價數據").Range("A2") '** 指數 代號
複製代碼
重啟後EXCEL呈現負載沒回應的狀態，嘗試等了5分鐘以上，其新的試算表(1-60分K紀錄)仍然為空白，接著就EXCEL無回應崩潰了，
之後在檔案重啟後關閉巨集運行，進行數次偵錯
都顯示在以下程式碼
  1. .Offset(1).Resize(, 3) = Array("時間", "多方加總", "空方加總")
複製代碼
不知是小弟哪邊操作上有誤嗎!?

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
7#
發表於 2018-10-16 15:48 | 顯示全部帖子
回復 10# GBKEE
G大午安
報價數據是透過期貨商API的將報價傳輸到電腦成為txt檔(這樣較能避免傳統DDE/RTD漏tick的情況發生)，再透過EXCEL去取得txt資料(附件裡面20180724_Match 這個txt檔)，我有設了巨集但路徑應該需要更改
由於是隨時間增加報價內容，而EXCEL似乎不會自動更新(我看內建最短要1分鐘)，所以將會設一個短時間延遲的報價連線的重新整理(視程式負擔)
附件為原始檔，原本有RTD的部分，需要外掛一堆期貨商的程式，所以先把那些欄位資料清掉了，因為那些資料只是呈現而已，巨集不會運用到，
再麻煩G大了，謝謝！

期貨看盤.rar (958.84 KB)

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
8#
發表於 2018-10-16 21:37 | 顯示全部帖子
回復 12# GBKEE

是股市營業時間一直在接收 然後"成為txt檔" ?

是的，我用元大的SMART API  ，開盤前先設定好商品名，就會在指定點建立一個無資料的txt，當開盤後開始有資料就會一直覆蓋，
我用過元大、永豐、XQ的DDE/RTD
但期貨交易太快，漏tick嚴重，快市交易之前測過，整天成交量漏了3成以上
所以才選用txt這種比較麻煩的方法，但是數據幾乎不會漏

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
9#
發表於 2018-10-18 09:58 | 顯示全部帖子
回復 14# GBKEE
G大早安，經過兩天的測試，發現可以運行，但都會在當下時間的前一筆紀錄的區域發生錯誤，例如現在時間9:36 就會只記錄到09:30後需要偵錯
  1. If .Cells.Offset(1) = "" And Format(TimeValue(.Cells.Text), "HH:MM") = "13:45" Then
複製代碼
標記這行代碼，但我也看不出是哪邊有問題，不過若以盤後執行的話速度確實飛快呀!!(盤後可以完整運行無偵錯)
以下是我調整過的
  1. Option Explicit
  2. Const 間隔 = #12:05:00 AM#   '這裡修改分鐘間隔
  3. Const 開盤 = #8:45:00 AM#
  4. Sub k_15()
  5.     Dim i As Long, Ti As Integer, 成交價 As Double, 多空 As Long, 多放 As Long
  6.     Dim xTime As Date
  7.     xTime = 開盤 + 間隔
  8.     i = 0: Ti = 0
  9.     Do
  10.         With Sheets("報價數據").Range("b2").Offset(i)
  11.             If 成交價 < .Cells(1, 2) Then 多放 = 多放 + .Cells(1, 3) Else 多空 = 多空 + .Cells(1, 3)
  12.             成交價 = .Cells(1, 2)
  13.             If .Value > xTime + 間隔 Then
  14.                 With Sheets("多空數據").Range("A2").Offset(Ti)
  15.                     .Resize(, 3) = Array(xTime, 多放, 多空)
  16.                     .NumberFormatLocal = "hh:mm;@"
  17.                 End With
  18.                  xTime = xTime + 間隔: Ti = Ti + 1
  19.              Else
  20.                 If .Cells.Offset(1) = "" And Format(TimeValue(.Cells.Text), "HH:MM") = "13:45" Then
  21.                     xTime = xTime + 間隔
  22.                     With Sheets("多空數據").Range("A2").Offset(Ti)
  23.                         .Resize(, 3) = Array(xTime, 多放, 多空)
  24.                         .NumberFormatLocal = "hh:mm;@"
  25.                     End With
  26.                     Exit Do
  27.                 ElseIf .Cells.Offset(1) = "" Then '****程式運行速度很快會跑完報價數據 **
  28.                      Do
  29.                         DoEvents
  30.                            '***程式等候... 報價文字檔的資料傳入**
  31.                      Loop Until Time >= xTime + #12:00:20 AM#
  32.                      重新整理
  33.                 End If
  34.             End If
  35.         End With
  36.         DoEvents
  37.         i = i + 1
  38.     Loop
  39.     MsgBox "工作完成"
  40. End Sub
複製代碼
  1. Sub 重新整理()
  2.     ActiveWorkbook.RefreshAll
  3. End Sub
複製代碼
報價數據的更新採用重新整理，其價格就會更新了，
另外，我看G大把巨集名稱設為K15，然後看執行的結果似乎是以15分鐘去紀錄多方加總與空方加總，
小弟愚笨，想詢問該如何調整為6樓的那項開高低收價格呢，謝謝！

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
10#
發表於 2018-10-20 16:42 | 顯示全部帖子
回復 16# GBKEE

謝謝G大，昨天不知是不是沒有開盤前執行，有一些小問題需要研究一番，等週一再來完整的測測看

TOP

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
123
返回列表 上一主題