GBKEE

回復 10# tonytw66
試試看

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

複製代碼

tonytw66

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

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

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

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

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

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

barrykuo

回復 16# lawlu
lawlu大大，您寫的一開始時間限制
If Timer >= 31440 And Timer <= 49560 Then '早上8:44起至13:46止
如果你是在早上8:44前執行可能不會繼續執行程式了。

而且我不會這樣寫在cells(x,y)裡面用時間去計算下一行
  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秒,往下一列, 填最新數值
建議你考慮用
Sheets("yyyyyy").[a65536].End(xlUp).Row
去檢查活頁簿最後一行來做記錄,yyyyyy代表活頁簿的名稱，a代表row的這一個行最後一個有記錄行號。

barrykuo

回復 16# lawlu
對不起超過3分鐘不能再修改帖子，另外你需要
把
Sub StartTimer()
  
'從啟動excel 開始的那一刻起, 在60-(timer  mod 60)秒 (為了切齊整秒) 後開始執行

   Application.OnTime Now + (60 - (Timer Mod 60)) / 86400#, "myPrg"
      
End Sub
放在ThisWorkbook
Sub Workboor_open()'這裡改一下紅色字
  
'從啟動excel 開始的那一刻起, 在60-(timer  mod 60)秒 (為了切齊整秒) 後開始執行

   Application.OnTime Now + (60 - (Timer Mod 60)) / 86400#, "myPrg"
     
End Sub
不知道這樣對嘛？我是參考論壇上面這樣做。
(60 - (Timer Mod 60)) / 86400#這樣寫我不懂，要問論壇高手。
我只會這樣寫
Application.OnTime "08:45:00", "myPrg"
您參考看看！

lawlu

感謝barrykuo大大的回覆，小弟其實完全不懂VB，只是剛好爬文有看到他人寫好一個可用的程式，並稍微修改如我上面PO的程式內容，我是想將從券商的看盤軟體所接收到的DDE資訊如下，即時從08:45:00這一個時間點開始記錄，但是08:45無法成功，而08:46就可以了

時間                成交           買賣口差        筆差        盤差        盤比差%
13:44:59        9,364             -956                 -57         -834         -1.06
                                       
                                       
8:45                                       
8:46                9,376            -1,004           87           814         42.94

您建議紀錄資料用以下的程式，但小弟不是很了解，可否建議有其他的參考範例呢
謝謝您
Sheets("yyyyyy").[a65536].End(xlUp).Row
去檢查活頁簿最後一行來做記錄,yyyyyy代表活頁簿的名稱，a代表row的這一個行最後一個有記錄行號。

barrykuo

回復 19# lawlu
lawlu大大，大概懂你的意思了，有時間請多多查詢論壇上許多高手，我都是看他們的文章來學習的，雖然不是很懂。
你可以改寫成：

1. Sub workbook_open()
   
2. Application.OnTime TimeValue("08:44:00"), "myPrg"
   
3. End Sub

複製代碼

下載 (78.97 KB)

2014-7-22 10:21

然後把myPrg()改寫成：

1. Sub myPrg()
   
2.   If Timer <= 49560 Then Exit Sub '早上8:44起至13:46止
   
3.     datarow = Sheets("yyyyyy").[c65536].End(xlUp).Row
   
4.     ActiveSheet.Cells(datarow, 3).Value = Range("C2").Value '每60秒,往下一列, 填最新數值
   
5.     ActiveSheet.Cells(datarow, 4).Value = Range("D2").Value '每60秒,往下一列, 填最新數值
   
6.     ActiveSheet.Cells(datarow, 5).Value = Range("E2").Value '每60秒,往下一列, 填最新數值
   
7.     ActiveSheet.Cells(datarow, 6).Value = Range("F2").Value '每60秒,往下一列, 填最新數值
   
8.     ActiveSheet.Cells(datarow, 7).Value = Range("G2").Value '每60秒,往下一列, 填最新數值
   
9.   End If
   
10. Application.OnTime Now + TimeValue("00:01:00"), "myPrg"
    
11. End Sub

複製代碼

datarow = Sheets("yyyyyy").[c65536].End(xlUp).Row裡面的yyyyyy填上你記錄的活頁簿名稱
然後再試試看應該可以執行了。
我可以跟你交換其他心得嘛？barry_kuo@yahoo.com.tw,謝謝