返回列表 上一主題 發帖

程式碼如何寫以紀錄EXCEL的DDE數據每秒鐘紀錄)(已解決)

回復 1# jiuhtsair
  1. Sub Ex()
  2.         Dim A As Date
  3.         A = Time
  4.         Do
  5.           DoEvents
  6.           If Time > A Then
  7.             A = Time
  8.             Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1) = Time & Sheet1.[A1]
  9.             '請自行修改->EXCEL的資料(時間、開盤價、最高價、最低價、收盤價、單量、成交量)
  10.           End If
  11.         Loop
  12. End Sub
複製代碼

TOP

回復 7# jiuhtsair


試試看
  1. Sub Ex()
  2.         Dim A As Single
  3.         A = 0.361111   '時間 上午 08:40:00
  4.         j = 2
  5.         Do
  6.           DoEvents
  7.           'If Sheets(2).Cells(j, 2) > A Then
  8.           '  A = Sheets(2).Cells(j, 2)
  9.           If Sheets(1).Cells(2, 1) > A Then   'SHEETS(1)的A2大於 時間
  10.             A = Sheets(1).Cells(2, 1)         '更改時間為SHEETS(1)的A2
  11.         '  -- 附檔 Sheets(1).Cells(3, 5)......   為空白  --
  12.         'Sheets(2).Cells(j, 2) = Sheets(1).Cells(3, 5)
  13.         'Sheets(2).Cells(j, 3) = Sheets(1).Cells(3, 6)
  14.         'Sheets(2).Cells(j, 4) = Sheets(1).Cells(3, 7)
  15.         'Sheets(2).Cells(j, 5) = Sheets(1).Cells(3, 8)
  16.         'Sheets(2).Cells(j, 6) = Sheets(1).Cells(3, 9)
  17.         'Sheets(2).Cells(j, 7) = Sheets(1).Cells(3, 10)
  18.         Sheets(2).Cells(j, 2).Resize(1, 6) = Sheets(1).Cells(2, 5).Resize(1, 6).Value
  19.         O = 0
  20.         H = -99999
  21.         l = 99999
  22.         cumVol = V
  23.         j = j + 1
  24.           End If
  25.         Loop
  26. End Sub
複製代碼

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 13# ABK

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



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

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2018-4-27 09:41 編輯

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 做好事不能少我一人,做壞事不能多我一人。
返回列表 上一主題