麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 請問如何利用DDE提供的時間數據定期紀錄在excel活頁簿 [打印本頁]

作者: barrykuo 時間: 2014-7-1 17:35 標題: 請問如何利用DDE提供的時間數據定期紀錄在excel活頁簿

在本論壇看到許多利用電腦系統時間來定期紀錄股市數據，目前使用Private Sub Worksheet_Calculate()接收數據，因為電腦系統時間與看盤軟體時間不一致。
如果想利用看盤軟體顯示在活頁簿上的時間例如094500、104500、114500、124500、134500等時間來記錄股價開盤、最高、最低、收盤，該如何利用巨集寫下來記錄。
謝謝各位耐心觀看發問。

作者: owen06 時間: 2014-7-1 18:09

回復 1# barrykuo

用application.ontime可以達成你要的功能，但能否附個檔，show出你的表格內容，以便大家幫你設定。

作者: c_c_lai 時間: 2014-7-2 07:31

回復 1# barrykuo
"如果想利用看盤軟體顯示在活頁簿上的時間例如094500、104500、114500、124500、134500等時間來記錄股價開盤、最高、最低、收盤，該如何利用巨集寫下來記錄。"
判斷時間 (Time) 改以判斷『看盤軟體顯示在活頁簿上的時間』便行了。

作者: barrykuo 時間: 2014-7-2 08:36

回復 3# c_c_lai
謝謝owen06、C_C_Lai大大快速熱心回復，附上excel文件，昨晚寫的，因為不太會寫，所以請教這樣可以嗎?是否更有方便的判斷。
[attach]18610[/attach]

作者: c_c_lai 時間: 2014-7-2 10:54

本帖最後由 c_c_lai 於 2014-7-2 10:56 編輯

回復 4# barrykuo
你試著將

If oneH >= 1 Then
MsgBox "I got it!" ' 你欲寫入的資料內容
End If

複製代碼

換成這個測試例子，試著改成你所要的間距時段：

Sub Ex()
Dim MyStr
' 設定時間格式為 HH:MM:SS
MyStr = Format(Sheets("即時指數").Range("C3"), "00:00:00")
' 此例為每隔 5 分鐘執行一次 (5 x 60)
If (Minute(MyStr) * 60 + Second(MyStr)) Mod 300 = 0 Then
MsgBox "I got it!"
End If
End Sub

複製代碼

如此便成了你所要的關鍵性內容了。

作者: c_c_lai 時間: 2014-7-2 11:00

回復 4# barrykuo
又、計算A02.rar 一開啟會有錯誤訊息
是因為你少建立一個工作表單 "5K"。

作者: barrykuo 時間: 2014-7-2 11:30

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

作者: c_c_lai 時間: 2014-7-2 11:55

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

作者: barrykuo 時間: 2014-7-3 08:41

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

作者: tonytw66 時間: 2014-7-5 14:21

大家好，我有跟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

作者: GBKEE 時間: 2014-7-5 14:49

回復 10# tonytw66
試試看

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

複製代碼

作者: tonytw66 時間: 2014-7-5 21:48

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

作者: tonytw66 時間: 2014-7-5 22:26

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

在資料擷取的確解決了整時的部份，只不過在記錄資料時為何會出現相同時間(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 時間: 2014-7-5 22:31

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

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 時間: 2014-7-7 15:29

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

作者: lawlu 時間: 2014-7-19 21:13

各位大大:
小弟從他處取得一個紀錄每分鐘即時期貨報價資料的程式修改如下，
但是期貨的開盤時間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 時間: 2014-7-21 11:50

回復 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 時間: 2014-7-21 12:01

回復 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 時間: 2014-7-21 16:16

感謝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 時間: 2014-7-22 10:26

本帖最後由 barrykuo 於 2014-7-22 10:28 編輯

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

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

複製代碼

[attach]18738[/attach]

然後把myPrg()改寫成：

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

複製代碼

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

作者: lawlu 時間: 2014-7-22 16:12

Barry 大大您好:

依照您的建議修改如下
但卻跑出錯誤訊息

[attachimg]18740

作者: barrykuo 時間: 2014-7-22 17:09

回復 21# lawlu
抱歉，end if 刪除。

作者: lawlu 時間: 2014-7-22 17:45

barrykuo大大:

1. 已將end if 刪除
2.程式是沒有出現錯誤訊，但還是沒有紀錄資料
3.不知是否因您之前有提到datarow = Sheets("yyyyyy").[c65536].End(xlUp).Row裡面的yyyyyy填上你記錄的活頁簿名稱

而我將檔名設為"EURO"，所以我將yyyyyy填上EURO，也就是說如下:

datarow = Sheets("EURO").[c65536].End(xlUp).Row

才造成無法RUN程式

感謝回復

作者: barrykuo 時間: 2014-7-23 13:41

回復 23# lawlu
lawlu大大，我按自己習慣改了程序，設定5秒記錄一次沒有問題，請再看看。
[attach]18747[/attach]
[attach]18748[/attach]

作者: lawlu 時間: 2014-7-23 23:14

barrykuo大大

依建議修改後，已經可以run了
謝謝您

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