1234
返回列表 上一主題 發帖

[發問] 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)

收藏 分享

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2018-10-13 08:55 | 只看該作者
本帖最後由 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

dreamsway

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

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2018-10-13 12:47 | 只看該作者
回復 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

dreamsway

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

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
6#
發表於 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

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2018-10-15 15:34 | 只看該作者
回復 6# dreamsway

明天開盤 可測看看

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

TOP

dreamsway

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

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
9#
發表於 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

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2018-10-16 10:50 | 只看該作者
本帖最後由 GBKEE 於 2018-10-16 10:53 編輯

回復 9# dreamsway

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

這資料是哪裡來的



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

TOP

        靜思自在 : 虛空有盡．我願無窮，發願容易行願難。
1234
返回列表 上一主題