返回列表 上一主題 發帖

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

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

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

接著依照Sht1.Range("C1")的時間,將運算的結果(Sht2.Cells(4, "J")與Sht2.Cells(5, "J"))   貼在Sht3的B.C欄

1539368012427.jpg
2018-10-13 02:14
  1. Sub 多空紀錄()
  2. Call 共用參照 '測試用

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

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

依時間紀錄.rar (16.85 KB)

本帖最後由 GBKEE 於 2018-10-13 09:01 編輯

回復 1# dreamsway
參考看看
  1. Option Explicit
  2. Public uMode&, StartTime, EndTime
  3. Public MyBook As Workbook, Sht1 As Worksheet, Sht2 As Worksheet, Sht3 As Worksheet, xRow&
  4. Sub 共用參照()
  5.     Set MyBook = ThisWorkbook
  6.     Set Sht1 = MyBook.Sheets("多空藍圖")
  7.     Set Sht2 = MyBook.Sheets("報價數據")
  8.     Set Sht3 = MyBook.Sheets("多空數據")
  9.     StartTime = "08:44:50"  '開盤時間(提早十秒開始,才可記錄開盤量價)
  10. End Sub
  11. Sub 報價運算()
  12.     Dim xTime As Date
  13.     Call 共用參照 '測試用
  14.     If Sht2.Range("H2") <> 1 Then '開盤條件
  15.         Sht2.Range("J2,J4,J5").ClearContents '清除紀錄資料
  16.         Sht2.Range("K2") = Sht2.Range("I2") '判斷價改為開盤價
  17.     End If
  18.     i = 1
  19.     xTime = Time
  20.     Do
  21.                 If Time > xTime Then  'Time 以秒計算的 ** Time > xTime = >下一秒 **
  22.             i = i + 1: xTime = Time
  23.             If Sht2.Cells(2, "J") = "↑" And Sht2.Cells(i, "H") <> 1 Then '多方加總
  24.                 Sht2.Range("J4") = Sht2.Range("J4") + Sht2.Range("D" & i)
  25.             End If
  26.             If Sht2.Cells(2, "J") = "↓" And Sht2.Cells(i, "H") <> 1 Then '空方加總
  27.                 Sht2.Range("J5") = Sht2.Range("J5") + Sht2.Range("D" & i)
  28.             End If
  29.             If Sht2.Cells(i, "H") <> 1 Then '報價時間傳送到多空藍圖
  30.                 Sht1.Cells(1, "C") = Sht2.Range("B" & i)
  31.             End If
  32.             Call 多空紀錄
  33.             Sht2.Cells(i, "H") = 1 '運算過的進行標記避免重複運算
  34.         End If
  35.     Loop Until Sht2.Range("C" & i + 1) = 0 '迴圈停止條件
  36. End Sub
  37. Sub 多空紀錄()
  38.      Dim xMinute As Integer
  39.         Call 共用參照 '測試用
  40.         xMinute = Int(Application.Text(Time - #8:45:00 AM#, "[M]") / 5)
  41.         '*** xMinute 以 Time 距 8:45 的分鐘數 / 5 傳回的整數
  42.         '*** Time 小於 8:45 得到負數
  43.         If xMinute > -1 And Time <= #1:45:00 PM# Then
  44.             xMinute = xMinute + 2   '*** 從第2列開始
  45.             Sht3.Cells(xMinute, "B") = Sht2.Cells(4, "J")
  46.             Sht3.Cells(xMinute, "C") = Sht2.Cells(5, "J")
  47.         End If
  48. End Sub
  49. Sub 清除標記()
  50.     Call 共用參照 '測試用
  51.     Sht2.Columns("H").Clear
  52.     Sht2.Cells(1, "H").Value = "標記"
  53. End Sub
  54. Sub 清除報價()
  55.     Dim qyt As QueryTable '刪除外部連線
  56.     Call 共用參照 '測試用
  57.     With Sht2
  58.         .Columns("A:G").Clear '刪除後將標題名稱填入
  59.         .Columns("A:G").Rows(1) = Array("代號", "時間", "成交價", "單量", "總量", "最高價", "最高價", "最低價")
  60.         For Each qyt In .QueryTables
  61.             qyt.Delete
  62.         Next
  63.     End With
  64. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 2# GBKEE
謝謝超版G大的協助
試運行了程式,發現會連報價運算的部分都變成1秒計算一次,
而多空紀錄似乎是以電腦時間來做紀錄,

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

TOP

回復 3# dreamsway
請自行試改看看
Sub 多空紀錄() 中 Time 改成 Sht1.Range("C1")
  1. Sub 報價運算()
  2.     Dim xTime As Date
  3.     Call 共用參照 '測試用
  4.     If Sht2.Range("H2") <> 1 Then '開盤條件
  5.         Sht2.Range("J2,J4,J5").ClearContents '清除紀錄資料
  6.         Sht2.Range("K2") = Sht2.Range("I2") '判斷價改為開盤價
  7.     End If
  8.     i = 1
  9.     xTime = Time
  10.     Do
  11.         i = i + 1
  12.         If Sht2.Cells(2, "J") = "↑" And Sht2.Cells(i, "H") <> 1 Then '多方加總
  13.             Sht2.Range("J4") = Sht2.Range("J4") + Sht2.Range("D" & i)
  14.         End If
  15.         If Sht2.Cells(2, "J") = "↓" And Sht2.Cells(i, "H") <> 1 Then '空方加總
  16.             Sht2.Range("J5") = Sht2.Range("J5") + Sht2.Range("D" & i)
  17.         End If
  18.         If Sht2.Cells(i, "H") <> 1 Then '報價時間傳送到多空藍圖
  19.             Sht1.Cells(1, "C") = Sht2.Range("B" & i)
  20.         End If
  21.         If Time > xTime Then  '** 一秒運行一次    **
  22.             xTime = Time
  23.             Call 多空紀錄
  24.         End If
  25.         Sht2.Cells(i, "H") = 1 '運算過的進行標記避免重複運算
  26.     Loop Until Sht2.Range("C" & i + 1) = 0 '迴圈停止條件
  27. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 4# GBKEE
謝謝G大 原本遇到一些問題,
研究了一下,紀錄的部分都解決了!
謝謝!

TOP

回復 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

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

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

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

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

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

15分K紀錄.rar (19.87 KB)

TOP

回復 6# dreamsway

明天開盤 可測看看

    依時間紀錄.zip (29.26 KB)
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 7# GBKEE
謝謝超版G大,明天盤中測試看看,
雖然說這次的程式對我實在太深奧了,
還有好長的一條路,我會努力學習的!

TOP

回復 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

本帖最後由 GBKEE 於 2018-10-16 10:53 編輯

回復 9# dreamsway

由於現在是每一筆成交就進行一次運算,1秒內可能成交很多筆交易

這資料是哪裡來的



多空藍圖 上是需填上Dee公式的如你沒有
請附上你的原始檔案看看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 君子如水,隨方就圓,無處不自在。
返回列表 上一主題