ABK

回復 8# GBKEE



版大您好!    我用Excel2016版， 跑程式碼卡住了，是哪裡有問題?
資料源 我改成元大RTD了!

GBKEE

回復 11# ABK

Sheets("1")的A 2 公式=RTD("money.excel",,"*SYSTEM","ServerTime")
是否傳回#N/A (錯誤值),導致程式錯誤試試看

1. Sub Ex()
   
2. Set MyBook = ThisWorkbook
   
3. Set Sht1 = MyBook.Sheets("1")
   
4.         Dim A As Single
   
5.         A = 0.361111   '時間 上午 08:40:00
   
6.         j = 2
   
7.         Do
   
8.             DoEvents
   
9.             '********測試用  ******************************************
   
10.             If IsError(Sht1.Cells(2, 1)) Then Stop  '傳回錯誤值 程式暫停
    
11.             '**********************************************************
    
12.             If Not IsError(Sht1.Cells(2, 1)) Then
    
13.                 If Sht1.Cells(2, 1) > A Then   'SHEETS(1)的A2大於 時間
    
14.                     A = Sht1.Cells(2, 1)         '更改時間為SHEETS(1)的A2
    
15.                     Sht1.Cells(j, 2).Resize(1, 6) = Sht1.Cells(2, 5).Resize(1, 6).Value
    
16.                     O = 0
    
17.                     H = -99999
    
18.                     l = 99999
    
19.                     cumVol = V
    
20.                     j = j + 1
    
21.                 End If
    
22.             End If
    
23.         Loop
    
24. End Sub

複製代碼

ABK

回復 12# GBKEE


謝謝版大!   出現型態不符

GBKEE

回復 13# ABK

=RTD("money.excel",,"*SYSTEM","ServerTime")
這 式我沒有你的檔案無法測試

下載 (171.37 KB)

2018-4-25 18:46

ABK

回復 14# GBKEE


謝謝版大!  按下偵錯後如附圖 !
附件我改成元大Yeswin 的 DDE。

15:00~ 隔日05:00  A2:J2  資料會變動 (午夜盤交易時段)

8:45 ~ 13:45   N2:W2    資料會變動 (日盤交易時段)

資料連結需先開啟 元大Yeswin 看盤軟體

GBKEE

回復 15# ABK
我只有台新證券公司的智多星可用.

可再試試看

1. Sub Ex()
   
2.     Dim Sht1 As Worksheet, MyBook As Workbook, A As Date
   
3.     Set MyBook = ThisWorkbook
   
4.     Set Sht1 = MyBook.Sheets("1")
   
5.         A = #8:40:00 AM#
   
6.         'Date 函數 傳回一 Variant (Date)，內容為系統日期 (電腦所記錄的現在日期)。
   
7.         j = 2
   
8.         Do
   
9.             DoEvents
   
10.             '********測試用  ******************************************
    
11.            ' If IsError(Sht1.Cells(2, 1)) Then Stop  '傳回錯誤值 程式暫停
    
12.             '**********************************************************
    
13.             If Not IsError(Sht1.Cells(2, 1)) Then
    
14.               '''  MsgBox TypeName(Sht1.Cells(2, 1).Value)
    
15.                 If Sht1.Cells(2, 1) > A Then   'SHEETS(1)的A2大於 時間
    
16.                     A = Sht1.Cells(2, 1)         '更改時間為SHEETS(1)的A2
    
17.                     Sht1.Cells(j, 2).Resize(1, 6) = Sht1.Cells(2, 5).Resize(1, 6).Value
    
18.                     O = 0
    
19.                     H = -99999
    
20.                     l = 99999
    
21.                     cumVol = V
    
22.                     j = j + 1
    
23.                 End If
    
24.             End If
    
25.         Loop
    
26. End Sub

複製代碼

ABK

回復 16# GBKEE


    感謝版主 !      可以記錄了!
   目前是1秒鐘記錄一次，  如何修改 讓它1分鐘 記錄一次 ?
   如果我要指定它在 15:00:00  (下午3點時自動停止)  要如何寫?

GBKEE

回復 17# ABK
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Sht1 As Worksheet, MyBook As Workbook, Rng As Range
   
4.     Dim xTime As Date
   
5.     Set MyBook = ThisWorkbook
   
6.     Set Sht1 = MyBook.Sheets("1")
   
7.     xTime = Time       '不要管Sht1.Cells(2, 1)的時間
   
8.     Do
   
9.             DoEvents
   
10.            If Time >= xTime Then  
    
11.                 xTime = TimeSerial(Hour(Time), Minute(Time) + 1, 0)   '下一分鐘
    
12.                 Set Rng = Nothing
    
13.                 If Time >= #8:40:00 AM# And Time <= #1:30:00 PM# Then    '日盤
    
14.                     Set Rng = [N2:W2]
    
15.                 ElseIf Time >= #2:59:50 PM# Or Time <= #5:00:10 AM# Then
    
16.                 '時間要跨過隔日
    
17.                 'http://forum.twbts.com/thread-20727-1-1.html
    
18.                 '夜盤 StartTime 14:59:50  /  EndTime 隔日 05:00:10
    
19.                     Set Rng = [A2:J2]
    
20.                
    
21.                 End If
    
22.                 If Not Rng Is Nothing Then
    
23.                     With Cells(Rows.Count, "A").End(xlUp).Offset(1)
    
24.                         .Resize(, Rng.Count) = Rng.Value
    
25.                     End With
    
26.                 End If
    
27.             End If
    
28.         Loop
    
29. End Sub

複製代碼

ABK

回復 18# GBKEE


謝謝版大 !     可以跑了!

紀錄時間都在58秒 是我的電腦時間比卷商主機時間(A2儲存格) 快2秒的原因!

yen956

ABK大大你好:
請問大大, 你是如何修改 標題 的?(如:加上 已解決)
是積分問題嗎? 我總是試不出來, 謝謝!!