Board logo

標題: 關於盤中開啟DDE每五分鐘抓一次 [打印本頁]
作者: 8BQGIGIGAGA    時間: 2013-1-25 13:03     標題: 關於盤中開啟DDE每五分鐘抓一次

' DDE 資料紀錄問題
Option Explicit
Dim actEnabled As Boolean
Dim cIndex As Single

Private Sub Workbook_Open()
    ' 以下四列資料之設定，可配合實作、或測試之目的，直接在 "sheet1" 指定之設定欄，得隨時予以異動。
    If (Sheets("sheet1").Range("BA1").Value = "") Then Sheets("sheet1").Range("BA1").Value = "08:45:00"   ' 假設C6欄位為空白，則寫入開盤起始時間
    If (Sheets("sheet1").Range("BA2").Value = "") Then Sheets("sheet1").Range("BA2").Value = "13:45:59"   ' D6欄位亦同。(此兩欄紀錄起始終止時間)
    If (Sheets("sheet1").Range("BB1").Value = "") Then Sheets("sheet1").Range("BB1").Value = "00:01:00"   ' 紀錄資料匯入相隔時間，如每隔一分鐘寫入一次。
    If (Sheets("sheet1").Range("BB2").Value = "") Then Sheets("sheet1").Range("BB2").Value = 0            ' 紀錄已匯入資料列數。

    If (TimeValue(Now) > Sheets("sheet1").Range("BA2").Value) Then       ' 如果目前時間業已超過 D6 的營業時段，則呼叫.......
        Call stopProcedure
    Else                                                                 ' 反之在 D6 設定時間以前，則呼叫.......
        Call startProcedure
    End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Call actStop
End Sub

Sub startProcedure()       ' 保留作為控制項之應用程序，如按鈕之巨集應用等。
    Call actStart
End Sub

Sub stopProcedure()        ' 保留作為控制項之應用程序，如按鈕之巨集應用等。
   Call actStop
End Sub

Sub newTitle()
    Sheets(2).[A1].Resize(, 4) = Sheets(1).[A1:D1].Value  ' 套上你欲匯入資料的表頭名稱
End Sub

Sub Starter()
    If (actEnabled = True And TimeValue(Now) >= Sheets("sheet1").Range("BA1").Value And TimeValue(Now) <= Sheets("sheet1").Range("BA2").Value) Then
        cIndex = Sheets("sheet1").Range("BB2").Value

        If (cIndex = 0) Then Call newTitle  ' newTitle 程序 (由使用者自行定義) 是將第一列的資料抬頭名稱寫入到sheet2；如日期、時間的對應欄位資料等。

        Sheets("sheet1").Range("BB2").Value = cIndex + 1       ' 紀錄列號加一。

        ' 複製從券商DDE匯入之相對應位置資料，如 A1、B1、C1、D1 對應的可能是內盤、外盤、成交、漲跌等等，以此類推。
        Sheets(2).[A65536].End(xlUp).Offset(1).Resize(, 4) = Sheets(1).[A2:D2].Value

        cIndex = Sheets("sheet1").Range("BB2").Value      ' 切記 Counter (計數器) 要加一，否則永遠為零 (當然已也可以不予紀錄資料列述，依個人習性)。
    End If
End Sub

Sub onStarter()
    If Not IsError(Sheets(1).[A2]) Then Call Starter
    If actEnabled Then Call actStart
End Sub

Sub actStart()
    actEnabled = True
   
    Application.OnTime (Now + Sheets("sheet1").Range("BB1").Value), "ThisWorkBook.onStarter"     ' 寫入資料的排程 (目前是每隔五分鐘寫入一次)
End Sub

Sub actStop()
    actEnabled = False

    On Error Resume Next
    Application.OnTime Now, "ThisWorkBook.onStarter", , False
End Sub

用這套下去修改 但是盤中開啟時抓取時間都不是 五分鐘K的時間 例如: 11:59:31
請問該如何修改 讓他在 五分鐘整分抓取
作者: c_c_lai    時間: 2013-1-26 07:24

回復 1# 8BQGIGIGAGA
請上傳你的 Excel 檔案！
作者: 8BQGIGIGAGA    時間: 2013-1-26 13:32

檔案在此 請大大幫忙:)
作者: c_c_lai    時間: 2013-1-27 09:56

回復 3# 8BQGIGIGAGA
試試看！
  1. Sub onStarter()
  2.     Dim nums As Integer
  3.     Dim tmStr As String
  4.    
  5.     tmStr = Format(Sheets("sheet1").Range("BB1").Value, "hh:mm:ss")
  6.     nums = (Left(tmStr, Len(tmStr) - 6) * 3600) + (Mid(tmStr, Len(tmStr) - 4, 2) * 60) + (Right(tmStr, 2) * 1)

  8.     If (IIf(nums >= 60, Minute(Time)*60+Second(Time), Second(Time)) Mod nums) = 0 Then  ' 間隔 nums 分、秒
  9.          If Not IsError(Sheets(1).[A2]) Then Call Starter
  10.          If actEnabled Then Call actStart
  11.     Else
  12.         Application.OnTime (Now + TimeValue("00:00:01")), "ThisWorkbook.onStarter"    ' 考慮每隔 .. 秒記錄一次
  13.     End If
  14. End Sub

  16. Sub actStart()
  17.     actEnabled = True
  18.    
  19.     Application.OnTime (Now + TimeValue("00:00:01")),  "ThisWorkBook.onStarter"     ' 寫入資料的排程 (目前是每隔五分鐘寫入一次)
  20. End Sub
複製代碼
作者: 8BQGIGIGAGA    時間: 2013-1-28 11:54

大大我加進去以後變成不會存資料了@@
作者: c_c_lai    時間: 2013-1-28 15:25

大大我加進去以後變成不會存資料了@@
8BQGIGIGAGA 發表於 2013-1-28 11:54

你把程式加到哪裡？
回覆時請選按 "回復" 選紐，否則當事人不知道你已回復！
作者: 8BQGIGIGAGA    時間: 2013-1-29 08:58

回復 6# c_c_lai
不是取代原本的兩個 sub嗎
作者: c_c_lai    時間: 2013-1-29 10:42

回復  c_c_lai
不是取代原本的兩個 sub嗎
8BQGIGIGAGA 發表於 2013-1-29 08:58

沒錯！
所有程式碼應置放於 ThisWorkbook 內，
Private Sub Workbook_Open() 才會有所回應，
如果你使用 Private Sub Auto_Open() 便要放置於 模組 內。
那麼請問你把程式加到哪裡去了？
作者: 8BQGIGIGAGA    時間: 2013-1-29 22:02

回復 8# c_c_lai


    由於不知道怎麼解釋 請看[attach]14107[/attach]
作者: c_c_lai    時間: 2013-1-30 08:24

回復 9# 8BQGIGIGAGA
配合你的 DDE 資料稍稍修改了一些，試試看吧！
  1. ' DDE 資料紀錄問題
  2. Option Explicit
  3. Dim actEnabled As Boolean
  4. Dim i As Single

  6. Private Sub Workbook_Open()
  7.     ' 以下四列資料之設定，可配合實作、或測試之目的，直接在 "sheet1" 指定之設定欄，得隨時予以異動。
  8.     If (Sheets("sheet1").Range("BA1").Value = "") Then Sheets("sheet1").Range("BA1").Value = "08:45:00"   ' 假設C6欄位為空白，則寫入開盤起始時間
  9.     If (Sheets("sheet1").Range("BA2").Value = "") Then Sheets("sheet1").Range("BA2").Value = "13:45:59"   ' D6欄位亦同。(此兩欄紀錄起始終止時間)
  10.     If (Sheets("sheet1").Range("BB1").Value = "") Then Sheets("sheet1").Range("BB1").Value = "00:05:00"   ' 紀錄資料匯入相隔時間，如每隔一分鐘寫入一次。
  11.     If (Sheets("sheet1").Range("BB2").Value = "") Then Sheets("sheet1").Range("BB2").Value = 0            ' 紀錄已匯入資料列數。

  13.     If (TimeValue(Now) > Sheets("sheet1").Range("BA2").Value) Then       ' 如果目前時間業已超過 D6 的營業時段，則呼叫.......
  14.         Call stopProcedure
  15.     Else                                                                 ' 反之在 D6 設定時間以前，則呼叫.......
  16.         Call startProcedure
  17.     End If
  18. End Sub

  20. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  21.     On Error Resume Next
  22.     Call actStop
  23. End Sub

  25. Sub startProcedure()        ' 保留作為控制項之應用程序，如按鈕之巨集應用等。
  26.     Call actStart
  27. End Sub

  29. Sub stopProcedure()        ' 保留作為控制項之應用程序，如按鈕之巨集應用等。
  30.    Call actStop
  31. End Sub

  33. Sub newTitle()
  34.     Sheets(2).[A1].Resize(, 7) = Sheets(1).[A1:G1].Value  ' 套上你欲匯入資料的表頭名稱
  35. End Sub

  37. Sub Starter()
  38.     Dim cIndex As Single
  39.    
  40.     If (actEnabled = True And TimeValue(Now) >= Sheets("sheet1").Range("BA1").Value And TimeValue(Now) <= Sheets("sheet1").Range("BA2").Value) Then
  41.         cIndex = Sheets(2).[A65536].End(xlUp).Row

  43.         If (cIndex = 1) Then Call newTitle  ' newTitle 程序 (由使用者自行定義) 是將第一列的資料抬頭名稱寫入到sheet2；如日期、時間的對應欄位資料等。

  45.         Sheets("sheet1").Range("BB2").Value = cIndex       ' 紀錄列號。

  47.         ' 複製從券商DDE匯入之相對應位置資料，如 A1、B1、C1、D1 對應的可能是內盤、外盤、成交、漲跌等等，以此類推。
  48.         Sheets(2).[A65536].End(xlUp).Offset(1).Resize(, 7) = Sheets(1).[A2:G2].Value
  49.     End If
  50. End Sub

  52. Sub onStarter()
  53.     Dim nums As Integer
  54.     Dim tmStr As String
  55.    
  56.     tmStr = Format(Sheets("sheet1").Range("BB1").Value, "hh:mm:ss")
  57.     nums = (Left(tmStr, Len(tmStr) - 6) * 3600) + (Mid(tmStr, Len(tmStr) - 4, 2) * 60) + (Right(tmStr, 2) * 1)

  59.     If (IIf(nums >= 60, Minute(TIME) * 60 + Second(TIME), Second(TIME)) Mod nums) = 0 Then ' 間隔 nums 分、秒
  60.          If Not IsError(Sheets(1).[C2]) Then Call Starter                         ' 考慮每隔 ..五分鐘記錄一次
  61.          If actEnabled Then Call actStart
  62.     Else
  63.         Application.OnTime (Now + TimeValue("00:00:01")), "ThisWorkbook.onStarter"
  64.     End If
  65. End Sub

  67. Sub actStart()
  68.     If actEnabled Then
  69.         ' 第二次(含)以後均以設定之 "間隔時段" 來處理執行序的作業。
  70.         Application.OnTime (Now + TimeValue("00:00:01")), "ThisWorkbook.onStarter"
  71.     Else
  72.         actEnabled = True
  73.         
  74.         ' 將第一次啟動時間更改為設定 "開盤時間"前，如果開啟 Excel 時，已經過了設定 "開盤時間"，則一進入系統即直接去執行紀錄作業。
  75.          If (TimeValue(Now) <= Sheets("sheet1").Range("BA1").Value) Then
  76.              Application.OnTime (TimeValue("08:45:00")), "ThisWorkbook.onStarter"
  77.          Else
  78.             ' 系統剛連上 DDE 至資料匯入Excel工作表單，須有一個緩衝時段，
  79.             ' 這時如果馬上去抓取DDE資料，會有型態不符的錯誤訊息產生，並中斷執行序的作業。
  80.             Application.OnTime (Now + TimeValue("00:00:05")), "ThisWorkbook.onStarter"
  81.          End If
  82.     End If
  83. End Sub

  85. Sub actStop()
  86.     actEnabled = False

  88.     On Error Resume Next
  89.     Application.OnTime Now, "ThisWorkBook.onStarter", , False
  90. End Sub
複製代碼
作者: 8BQGIGIGAGA    時間: 2013-1-30 21:25

回復 10# c_c_lai


感謝C大 可以了!



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)