1234
返回列表 上一主題 發帖

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

dreamsway

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

GBKEE

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

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

回復 11# dreamsway

"透過期貨商API的將報價傳輸到電腦成為txt檔"
是股市營業時間一直在接收 然後"成為txt檔" ?

"原本有RTD的部分，需要外掛一堆期貨商的程式"
給你的檔案就是輸入這些的公式,於股市營業時間接收資料
我是用台新證券的智多星看盤 接收資料



這裡要修改
ThisWorkbook.Sheets("多空藍圖").Range("A2") '** 指數 代號
  1. Sub AUTO_OPEN()
  2. Dim i As Integer, A, Rng As Range, xName As String, n As Name
  3. '*** 設定分鐘的間隔***
  4. Names.Add "Ar", Array("1分", "5分", "10分", "15分", "20分", "30分", "60分")
  5. Set Rng = ThisWorkbook.Sheets("多空藍圖").Range("A2") '** 指數 代號
  6. On Error GoTo Sh_Add '處理程式錯誤時的措施
複製代碼
這裡要修改
Dim 成交價 As Double, 多空 As Long, 多放 As Long
With ThisWorkbook.Sheets(Rng(1).Value) '**工作表(指數代號)
  1. Private Sub Worksheet_Calculate()
  2. Dim Rng(1 To 2) As Range, i As Integer, xName As String, xTime(1 To 2) As Date, T(1 To 2) As Integer
  3. Dim 成交價 As Double, 多空 As Long, 多放 As Long
  4. If IsError([sum(a:e)]) Then Exit Sub '**開盤前的清盤DEE有時會傳回空值 #NA
  5. Set Rng(1) = [a2] '**第一個指數代號
  6. xTime(1) = #8:45:00 AM# '**開盤時間
  7. Do While Rng(1) <> "" '**執行迴圈的條件是 指數代號<>""
  8. With ThisWorkbook.Sheets(Rng(1).Value) '**工作表(指數代號)
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

dreamsway

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

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

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

TOP

GBKEE

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

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

但期貨交易太快，漏tick嚴重，快市交易之前測過，整天成交量漏了3成以上
所以才選用txt這種比較麻煩的方法，但是數據幾乎不會漏

    檔案上另加一模組複製這程式 試試看
  1. Option Explicit
  2. Const 間隔 = #12:15: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:30 AM#
  32.                      匯入API報價文字檔
  33.                 End If
  34.             End If
  35.         End With
  36.         DoEvents
  37.         i = i + 1
  38.     Loop
  39.     MsgBox "工作完成"
  40. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

dreamsway

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

GBKEE

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

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

回復 15# dreamsway
再試試看
  1. Option Explicit
  2. Const K = #12:15:00 AM#   '這裡修改
  3. Const 開盤 = #8:45:00 AM#
  4. Sub k_15()
  5.     Dim i As Long, Ti(1 To 3) As Integer, 成交價 As Double
  6.     Dim xTime As Date, AR(1 To 6)
  7.     AR(1) = "時間": AR(2) = "開盤": AR(3) = "最高": AR(4) = "最低": AR(5) = "收盤": AR(6) = "成交量"
  8.     With Sheets("多空數據")
  9.         .UsedRange.Clear                                                      '清盤
  10.         .[A1].Resize(, UBound(AR)) = AR                                       '給標頭
  11.     End With
  12.     xTime = 開盤 + IIf(K = #12:01:00 AM#, 0, K)                         '開盤+ K 的分鐘數
  13.     Ti(2) = Application.Text(xTime, "[m]")
  14.     Ti(3) = 0       'K數次
  15.     i = 0
  16.     AR(1) = xTime: AR(2) = 0: AR(3) = 0: AR(4) = 0: AR(5) = 0: AR(6) = 0
  17.     Do
  18.         With Sheets("報價數據").Range("b2").Offset(i)
  19.             成交價 = .Range("B1")
  20.             Ti(1) = Application.Text(.Cells.Offset(1), "[m]")                   '下一個報價時間的分鐘數
  21.             AR(2) = IIf(AR(2) = 0, 成交價, AR(2))                               '開盤
  22.             AR(3) = IIf(成交價 >= AR(3), 成交價, AR(3))                         '最高
  23.             AR(4) = IIf(AR(4) = 0, 成交價, IIf(成交價 <= AR(4), 成交價, AR(4))) '最低
  24.             AR(6) = AR(6) + .Range("C1")                                        '成交量
  25.             If Ti(1) > Ti(2) Then
  26.                 AR(5) = 成交價                                                  '收盤"
  27.                 With Sheets("多空數據").Range("A2").Offset(Ti(3))
  28.                     .Resize(, UBound(AR)) = AR
  29.                     .NumberFormatLocal = "hh:mm;@"
  30.                 End With
  31.                 xTime = xTime + K                     '下一個K時間點
  32.                 Ti(2) = Application.Text(xTime, "[m]")   '重新計算K時間點的分鐘數
  33.                 Ti(3) = Ti(3) + 1                        'K數次+1
  34.                 AR(1) = xTime: AR(2) = 0: AR(3) = 0: AR(4) = 0: AR(5) = 0: AR(6) = 0 ''陣列重新給值
  35.              Else
  36.                 If .Cells.Offset(1) = "" And CDate(.Cells.Value) = CDate(#1:45:00 PM#) Then
  37.                     AR(5) = .Cells.Offset(0, 1)                             '收盤"
  38.                     With Sheets("多空數據").Range("A2").Offset(Ti(3))
  39.                         .Resize(, UBound(AR)) = AR
  40.                         .NumberFormatLocal = "hh:mm;@"
  41.                     End With
  42.                     Exit Do
  43.                 ElseIf .Cells.Offset(1) = "" Then
  44.                     匯入API報價文字檔
  45.                 End If
  46.             End If
  47.         End With
  48.         DoEvents
  49.         i = i + 1
  50.     Loop
  51. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

dreamsway

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

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

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
18#
發表於 2018-10-21 15:43 | 只看該作者
回復 16# GBKEE
G大您好！ 原本之前以為是沒在開盤前執行，所以數據抓得不準確，
後來自己手動把原始的報價數據做過調整方便對照，
發現原本應該只到09:00:00的數據會記錄到09:00:59；09:15:00的數據則會記錄到09:15:59 (會往後推59秒.以此類推)
設想應該可以從程式判定分鐘的部分做調整，又或者把開盤時間設定往前移，(開盤設08:44:59，則會只紀錄到08:59:59)
但我試著更改了幾個部分皆無效，想詢問是否有改善方法呢，謝謝！

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
19#
發表於 2018-10-22 07:43 | 只看該作者
回復 18# dreamsway
試試看
  1. Option Explicit
  2. Const K = #12:15:00 AM#
  3. Const 開盤 = #8:45:00 AM#
  4. Sub k_15()
  5.     Dim i As Long, Ti(1 To 3) As Long, 成交價 As Double
  6.     Dim xTime As Date, AR(1 To 6)
  7.     AR(1) = "時間": AR(2) = "開盤": AR(3) = "最高": AR(4) = "最低": AR(5) = "收盤": AR(6) = "成交量"
  8.     With Sheets("多空數據")
  9.         .UsedRange.Clear                                                      '清盤
  10.         .[A1].Resize(, UBound(AR)) = AR                                       '給標頭
  11.     End With
  12.     xTime = 開盤 + IIf(K = #12:01:00 AM#, 0, K)                               '第一個K時間點
  13.     Ti(1) = Application.Text(xTime, "[S]")                                    'K時間點的秒數
  14.     Ti(3) = 0                                                                 'K數次
  15.     i = 0                                                                     '指定報價的列號                                               '
  16.     AR(1) = Format(xTime, "hh:mm"): AR(2) = 0: AR(3) = 0: AR(4) = 0: AR(5) = 0: AR(6) = 0 '陣列重新給值
  17.     Do
  18.         With Sheets("報價數據").Range("b2").Offset(i)
  19.             成交價 = .Range("B1")
  20.             Ti(2) = Application.Text(.Cells.Offset(1), "[S]")                   '.Cells.Offset(1) -> 下一個報價時間秒數
  21.             AR(2) = IIf(AR(2) = 0, 成交價, AR(2))                               '開盤
  22.             AR(3) = IIf(成交價 >= AR(3), 成交價, AR(3))                         '最高
  23.             AR(4) = IIf(AR(4) = 0, 成交價, IIf(成交價 <= AR(4), 成交價, AR(4))) '最低
  24.             AR(5) = 成交價                                                      '收盤
  25.             AR(6) = AR(6) + .Range("C1")                                        '成交量
  26.             If Ti(2) > Ti(1) Then                                               '下一個報價時間秒數 >     K點時間的秒數
  27.                 Sheets("多空數據").Range("A2").Offset(Ti(3)).Resize(, UBound(AR)) = AR  'k時間點導入陣列
  28.                 xTime = xTime + K                                               '下一個K時間點
  29.                 Ti(1) = Application.Text(xTime, "[S]")                          '下一個 K 點時間的秒數
  30.                 Ti(3) = Ti(3) + 1                                               'K數次+1
  31.                 AR(1) = Format(xTime, "hh:mm"): AR(2) = 0: AR(3) = 0: AR(4) = 0: AR(5) = 0: AR(6) = 0 '陣列重新給值
  32.              Else
  33.                 If .Cells.Offset(1) = "" And CDate(.Cells.Value) = CDate(#1:45:00 PM#) Then
  34.                     '下一個報價時間="" 且 報價時間=收盤時間
  35.                     Sheets("多空數據").Range("A2").Offset(Ti(3)).Resize(, UBound(AR)) = AR 'k時間點導入陣列
  36.                     Exit Do                                                      '離開迴圈
  37.                 ElseIf .Cells.Offset(1) = "" Then            '這條件不成立 (下一個報價時間="" 且 報價時間=收盤時間  )
  38.                     匯入API報價文字檔
  39.                 End If
  40.             End If
  41.         End With
  42.         DoEvents     '暫停執行，以便讓作業系統可以處理其它的事件
  43.         i = i + 1    '報價的列號 +1
  44.     Loop
  45. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

dreamsway

帖子
26 
主題
4 
精華
0 
積分
30 
點名
0  
作業系統
Win10 
軟體版本
Office2019 
閱讀權限
10 
性別
男 
註冊時間
2018-10-12 
最後登錄
2022-7-25 
20#
發表於 2018-10-25 12:07 | 只看該作者
回復 19# GBKEE
謝謝超版G大，之前在盤後使用完全正常，一到盤中實測就冒出問題
測試了好幾天，終於調整好了，謝謝！

TOP

        靜思自在 : 一個人的快樂．不是因為他擁有得多，而是因為他計較得少。
1234
返回列表 上一主題