dreamsway

回復 10# GBKEE
G大午安
報價數據是透過期貨商API的將報價傳輸到電腦成為txt檔(這樣較能避免傳統DDE/RTD漏tick的情況發生)，再透過EXCEL去取得txt資料(附件裡面20180724_Match 這個txt檔)，我有設了巨集但路徑應該需要更改
由於是隨時間增加報價內容，而EXCEL似乎不會自動更新(我看內建最短要1分鐘)，所以將會設一個短時間延遲的報價連線的重新整理(視程式負擔)
附件為原始檔，原本有RTD的部分，需要外掛一堆期貨商的程式，所以先把那些欄位資料清掉了，因為那些資料只是呈現而已，巨集不會運用到，
再麻煩G大了，謝謝！

GBKEE

回復 11# dreamsway

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

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

下載 (106.3 KB)

2018-10-16 16:29

這裡要修改
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) '**工作表(指數代號)

複製代碼

dreamsway

回復 12# GBKEE

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

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

GBKEE

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

複製代碼

dreamsway

回復 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樓的那項開高低收價格呢，謝謝！

GBKEE

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

複製代碼

dreamsway

回復 16# GBKEE

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

dreamsway

回復 16# GBKEE
G大您好！ 原本之前以為是沒在開盤前執行，所以數據抓得不準確，
後來自己手動把原始的報價數據做過調整方便對照，
發現原本應該只到09:00:00的數據會記錄到09:00:59；09:15:00的數據則會記錄到09:15:59 (會往後推59秒.以此類推)
設想應該可以從程式判定分鐘的部分做調整，又或者把開盤時間設定往前移，(開盤設08:44:59，則會只紀錄到08:59:59)
但我試著更改了幾個部分皆無效，想詢問是否有改善方法呢，謝謝！

GBKEE

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

複製代碼

dreamsway

回復 19# GBKEE
謝謝超版G大，之前在盤後使用完全正常，一到盤中實測就冒出問題
測試了好幾天，終於調整好了，謝謝！