lawlu

各位大大:
小弟從他處取得一個紀錄每分鐘即時期貨報價資料的程式修改如下，
但是期貨的開盤時間08:45:00該筆資料一直都無法成功記錄下來
不知可否請教各位前輩幫忙協助一下看是否有需要修改的地方
謝謝



Sub myPrg()

  If Timer >= 31440 And Timer <= 49560 Then '早上8:44起至13:46止
    ActiveSheet.Cells(Int((Timer - 31440) / 60) + 4, 3).Value = Range("C2").Value '每60秒,往下一列, 填最新數值
    ActiveSheet.Cells(Int((Timer - 31440) / 60) + 4, 4).Value = Range("D2").Value '每60秒,往下一列, 填最新數值
    ActiveSheet.Cells(Int((Timer - 31440) / 60) + 4, 5).Value = Range("E2").Value '每60秒,往下一列, 填最新數值
    ActiveSheet.Cells(Int((Timer - 31440) / 60) + 4, 6).Value = Range("F2").Value '每60秒,往下一列, 填最新數值
    ActiveSheet.Cells(Int((Timer - 31440) / 60) + 4, 7).Value = Range("G2").Value '每60秒,往下一列, 填最新數值
   
    Call Timer2 ' <------- 改為Timer2
  End If
   
End Sub

Sub Timer2()
'每60秒執行 "myPrg" 這個副程式
   Application.OnTime Now + 60 / 86400#, "myPrg"
      
End Sub
Sub StartTimer()
  
'從啟動excel 開始的那一刻起, 在60-(timer  mod 60)秒 (為了切齊整秒) 後開始執行

   Application.OnTime Now + (60 - (Timer Mod 60)) / 86400#, "myPrg"
      
End Sub

tonytw66

我自行修改吧檔案移置到RTD 資料擷取，都可正常運作，也沒有再出現重覆記錄。非常感謝GBKEE大大幫助。

tonytw66

附上 由程式上記錄資料情況說明.....

60        92        50        16        77        45        61        61        46        78        82        28        85        46        47        39        21        102        34        15        12        23        22:16:00
65        19        54        105        26        49        34        49        21        80        51        102        21        86        37        21        59        63        100        68        37        45        22:17:00   ...重覆相同時間....
91        96        71        48        11        82        77        47        104        54        53        105        15        64        100        48        106        81        32        106        38        45        22:17:00
40        66        40        42        45        14        106        31        87        41        49        33        99        88        31        85        81        17        61        14        34        19        22:18:00
54        107        80        107        49        83        73        64        26        34        83        97        57        14        59        35        87        27        87        49        34        71        22:19:00
97        46        67        103        32        78        65        92        83        43        29        91        79        108        53        67        50        15        54        40        33        35        22:20:00
26        22        76        72        91        30        29        72        88        57        73        25        81        50        67        87        92        93        66        25        64        24        22:21:00.......同時記錄了2筆相同時間，但資料不同
37        55        69        49        65        97        22        101        105        49        72        101        60        14        101        49        93        32        71        88        60        102        22:21:00
95        22        22        16        86        50        101        83        101        95        76        92        54        88        93        105        31        95        29        102        26        10        22:22:00
57        69        35        60        52        75        48        28        80        58        100        104        21        103        25        74        40        29        72        75        77        54        22:23:00............這裡都正常整時記錄
18        102        29        58        41        17        22        104        47        18        88        105        54        31        91        101        67        76        38        74        29        40        22:24:00
10        66        38        68        36        28        18        49        13        68        31        10        83        34        88        97        63        34        82        43        89        90        22:24:00
50        86        74        96        55        46        47        89        71        90        92        25        62        105        69        31        61        78        40        51        79        16        22:25:00
47        78        14        31        83        53        92        51        70        68        78        102        82        88        36        32        62        25        101        72        55        12        22:25:00
57        46        57        78        84        98        83        90        96        70        89        38        104        97        33        84        80        54        28        100        54        103        22:26:00
88        81        18        84        59        81        53        70        35        13        11        29        45        70        105        34        31        82        69        40        105        20        22:26:00

tonytw66

因目前無股市資訊可擷取，我用另一個自動產生亂數來測試整時資料擷取。

在資料擷取的確解決了整時的部份，只不過在記錄資料時為何會出現相同時間(ex ： 00:05:00) 連續記錄2筆相同資料？有時候又可正常依序記錄？

附上程式內容，是否有需要修正的地方來解決上述問題？


If Time > TimeValue(EndTime) Then '收盤時間以後不執行
    Sht2.[W4] = "已過收盤時問"
    uMode = 0
    Exit Sub
End If
Sht2.Range("W2") = Time '當前時間（時間碼表）
'----------------------------------------------------------
'每1分鐘記錄 Mod 1
If Second(Time) = 0 And Minute(Time) Mod 1 = 0 Then
   xRow = Sht1.Range("A65536").End(xlUp).Row + 1
   Sht1.Range("A" & xRow & ":V" & xRow).Value = Sht2.Range("A2:V2").Value
   Sht1.Range("W" & xRow).Value = Time
   '------------------------------------------------
   If ActiveSheet.Name = Sht1.Name And xRow > 25 Then
      ActiveWindow.ScrollRow = xRow - 15 '讓最新資料保持在可見視窗中
   End If
   ThisWorkbook.Save   '存檔
   Beep
End If
Application.OnTime TimeSerial(Hour(Time), Minute(Time) + 1, 0), "自動記錄"  '每1分記錄一次
End Sub

Sub 開始執行()
If uMode = 1 Then Exit Sub
Call 共用參照
uMode = 1
Sht2.[W4] = "執行中.."
Call 自動記錄
End Sub

Sub 停止執行()
uMode = 0
Call 共用參照
Sht2.[W4] = "已停止"
End Sub

另外請教是否不能同時開啟2個以上excel 檔2個獨力的 VBA程式？因為我開了2個excel檔案，但都只看到一個 VBA檔，而且似乎會相戶干擾？？

謝謝

tonytw66

感謝超級版主用"超級"速度幫忙解決問題。正在測試中！謝謝。

GBKEE

回復 10# tonytw66
試試看

1. Application.OnTime TimeSerial(Hour(Time), Minute(Time) + 1, 0), "自動記錄"

複製代碼

tonytw66

大家好，我有跟barrykuo大大有相同的問題，就是想擷取DDE的"整時"資料( ex ：00:01:00、00:02:00....)
，因為我對VBA沒有基礎，只是爬文抓適用程式來修改。但在整時資料擷取上仍無法獲得解決。
目前我把
Application.OnTime Now + TimeValue("00:00:0" & 59 - Second(Time) Mod 1), "自動記錄"   '每1分鐘遞迴一次
修改成這樣，但在記錄資料時，無法得到"準時"記錄，還出現1分內記錄2次、或者隔了幾分都沒動靜....。

因為我的權限不能下載barrykuo大大程式來比較，所以咧出我的程式，請教各位前輩如何解決。
Public uMode&, StartTime, EndTime

Sub 共用參照()
StartTime = "08:29:30"  '開盤時間（提早十秒開始，才可記錄開盤量價）
EndTime = "23:59:59"    '測試時間使用
End Sub

Sub 自動記錄()
Dim MyBook As Workbook, MySht As Worksheet, xEnd As Range
'--------------------------------------------------------------------------
If uMode = 0 Then Exit Sub
If Time > TimeValue(EndTime) Then Exit Sub '收盤時間以後不執行
Set MyBook = ThisWorkbook
Set MySht = MyBook.Sheets("DDE")
'讓程式只在本檔案的〔指定工作表〕中執行，否則會將資料寫到其它工作表
MySht.Range("AA6") = Time '當前時間（時間碼表）
'----------------------------------------------------------
If Val(MySht.Range("AA11").Value) > 0 Then
   Set xEnd = MySht.Range("A65536").End(xlUp)(2)
   If xEnd.Row < 12 Then Set xEnd = MySht.Range("A12")
   MySht.Range("A11:Z11").Value = MySht.Range("A6:Z6").Value
   xEnd.Resize(1, 26).Value = MySht.Range("A2:Z2").Value
   xEnd(1, 27).Value = Time
   '------------------------------------------------
   If ActiveSheet.Name = MySht.Name And xEnd.Row > 20 Then
      ActiveWindow.ScrollRow = xEnd.Row - 8 '讓最新資料保持在可見視窗中
   End If
   ThisWorkbook.Save   '存檔
End If
'----------------------------------------------------------
'每一分遞迴一次
Application.OnTime Now + TimeValue("00:00:0" & 59 - Second(Time) Mod 1), "自動記錄"
End Sub

Sub 開始執行()
Call 共用參照
uMode = 1
Call 自動記錄
End Sub

Sub 停止執行()
uMode = 0
End Sub

barrykuo

回復 8# c_c_lai
謝謝c_c_lai大大熱心指導!

c_c_lai

回復 7# barrykuo
那只好配合實際發生的數據去機動判斷了。

barrykuo

回復 6# c_c_lai
C_C_lai大大！
對不起忘記刪除5K相關敘述。
您提的方案是整除判斷餘數為零時，進行記錄。
我的問題是DDE數據連線進來，經過觀察有時不一定正點會有數據，所以不一定能整除，例如：09:44:58出現一比資料，然後在09:45:01才出現另一筆資料，這時前一小時的數據應該只到09:44:58必須完成統計。
才輸學淺，謝謝您耐心教導！