請問高手要將以下DDE 每分鐘記錄改為30秒自動記錄一次要怎改

xu123

我對VBA都不懂在網上找好久找到一個比較接近我要的範例
可是他是每分鐘記錄一次
可以請高手幫我改每30秒就記錄一次嗎
也謝謝這位提供範例的網友


Option Explicit
Dim LastMin As Integer

Private Sub Workbook_Open()
    Sheets("策略記錄").Cells(4, 2) = 10
    LastMin = Minute(Time)
    Call Timer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:01"), "ThisWorkbook.Timer", , False
End Sub


Public Sub Timer()
    Dim Pos As Integer, i As Integer, RangeStr As String
        
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:01"), "ThisWorkbook.Timer" '每秒顯示
    Sheets("策略記錄").Cells(3, 2) = Time '將時間show至策略的b3欄位
    Dim HHMM As Integer
    HHMM = Hour(Time) * 100 + Minute(Time)
    If (HHMM < 845 Or HHMM > 1345) Then Exit Sub '營業時間才執行
    If Minute(Time) <> LastMin Then '開始後做
        With Sheets("策略記錄")
            .Cells(4, 2) = .Cells(4, 2) + 1 '將變動行號加一行
            Pos = .Cells(4, 2)
            .Cells(Pos, 1) = Time
            .Cells(Pos, 2) = .Cells(2, 2)
            .Cells(Pos, 3) = .Cells(2, 3)
            .Cells(Pos, 4) = .Cells(2, 4)
            .Cells(Pos, 5) = .Cells(2, 5)
            .Cells(Pos, 6) = .Cells(2, 6)
            .Cells(Pos, 7) = .Cells(2, 7)
            .Cells(Pos, 8) = .Cells(2, 8)
            .Cells(Pos, 9) = .Cells(2, 9)
            .Cells(Pos, 10) = .Cells(2, 10)
           
         
        End With
   
        LastMin = Minute(Time)
    End If
End Sub

winwin

回復 131# fei6999


    去裝元大RTD； 它的範例檔就有； 只要有RTD(可把它看成DDE)， 再來就是程式的問題了

fei6999

回復 130# mlc994800


   元大dde都有提供範例!漲跌家數應該有才對

下載 (13.3 KB)
dde

2016-7-10 02:03

mlc994800

想請問如果想要一開盤就先把昨天每30秒記錄的資料移除,應該要再補上怎樣的程式碼呢??

另外,想請問一下,有些想知道的資訊如果證卷商沒有那個品項的代碼是不是就無法取得呢?
譬如:大盤的漲跌家數..etc.

kinyo1122

太棒拉  這裡終於找到我要的東西 酷哦:D

c_c_lai

回復 127# areskevin

1. Option Explicit
   
2. 
   
3. Dim LastMin As String
   
4. 
   
5. Private Sub Workbook_Open()
   
6.     LastMin = "00:01:00"
   
7.     Call Timer
   
8. End Sub
   
9. 
   
10. Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
11.     On Error Resume Next
    
12.     Application.OnTime Now + TimeValue("00:00:01"), "ThisWorkbook.Timer", , False
    
13. End Sub
    
14. 
    
15. Public Sub Timer()
    
16.     Dim Pos As Long, HHMM As Integer, col As Variant
    
17.         
    
18.     With Sheets("每分記錄")
    
19.         HHMM = Hour(Now) * 100 + Minute(Now)
    
20.         If (HHMM < 900 Or HHMM > 1333) Then Exit Sub
    
21.    
    
22.         .Cells(2, 4) = Now
    
23.         Set col = Range(.Range("A5"), .Cells(5, .[A4].End(xlToRight).Column)).Find(Format(.Cells(2, 4), "M/D"), LookIn:=xlValues, LookAt:=xlWhole)
    
24.         Pos = .Cells(Rows.Count, col.Column - 1).End(xlUp).Row + 1       '  均以其相對應之當日 (col) 為基準   (Pos = 6 : Long)
    
25.         '  Pos = .Range("A" & Rows.Count).End(xlUp).Row + 1
    
26.         .Cells(Pos, col.Column - 1) = Format(.Cells(2, 4), "HH:MM:SS")
    
27.         .Cells(Pos, col.Column) = .Cells(2, 2)
    
28.         .Cells(Pos, col.Column + 1) = .Cells(2, 3)
    
29.     End With
    
30.    
    
31.     Application.OnTime Now + TimeValue(LastMin), "ThisWorkbook.Timer"
    
32.     '  Application.OnTime Now + TimeValue("00:01:00"), "ThisWorkbook.Timer"
    
33. End Sub

複製代碼

收收 Mail！

下載 (85.94 KB)

2016-6-24 18:55

areskevin

回復 126# c_c_lai

c_c_lai大您好^^
剛剛嘗試了一下
把程序加入
還是無法跳動
請問如果相同語法寫入在2013的excel也可以嗎？
另外因為我無法下載附件，
能否麻煩您把附件寄送給我呢？
hsuhsuan1985@gmail.com
希望有朝一日能跟c_c_lai大一樣
能回復他人的問題
萬分感謝

c_c_lai

提供參考：
每分記錄(每月).rar (11.91 KB)

下載次數: 26

2016-6-22 07:21

c_c_lai

回復 120# areskevin
為了讓你能實際瞭解 "每分記錄" 的實務撰寫，
做了此應用範例，提供你得以全盤明瞭
如何去實際控制每月每日的真實操盤紀錄寫入
並再你原本的構想而整理出來之程式實際
應用範例，希望你藉此能舉一反三加以發揮。

下載 (122.44 KB)

2016-6-22 07:15

1. Public Sub Timer()
   
2.     Dim Pos As Long, HHMM As Integer, col As Variant
   
3.         
   
4.     With Sheets("每分記錄")
   
5.         HHMM = Hour(Now) * 100 + Minute(Now)
   
6.         If (HHMM < 900 Or HHMM > 1333) Then Exit Sub
   
7.    
   
8.         .Cells(2, 4) = Now
   
9.         '  Set col = Range(.Range("A5"), .Cells(5, .[A5].End(xlToRight).Column)).Find(Format(.Cells(2, 4), "M/D"), LookIn:=xlValues, LookAt:=xlWhole)
   
10.         '  Sheets("每分記錄").[A4].End(xlToRight).Column = 15 : Variant/Long
    
11.         '  Sheets("每分記錄").[A5].End(xlToRight).Column =  2 : Variant/Long  (合併儲存格易造成 End(xlToRight).Column 判斷錯誤)
    
12.         Set col = Range(.Range("A5"), .Cells(5, .[A4].End(xlToRight).Column)).Find(Format(.Cells(2, 4), "M/D"), LookIn:=xlValues, LookAt:=xlWhole)
    
13.         Pos = .Cells(Rows.Count, col.Column - 1).End(xlUp).Row + 1    '  均以其相對應之當日 (col) 為基準  
    
14.         '  Pos = .Range("A" & Rows.Count).End(xlUp).Row + 1
    
15.         .Cells(Pos, col.Column - 1) = Format(.Cells(2, 4), "HH:MM:SS")
    
16.         .Cells(Pos, col.Column) = .Cells(2, 2)
    
17.         .Cells(Pos, col.Column + 1) = .Cells(2, 3)
    
18.     End With
    
19.    
    
20.     '  Application.OnTime Now + TimeValue(LastMin), "ThisWorkbook.Timer"
    
21.     Application.OnTime Now + TimeValue("00:01:00"), "ThisWorkbook.Timer"
    
22. End Sub

複製代碼

c_c_lai

回復 120# areskevin

下載 (63.43 KB)

2016-6-21 19:32

1. Public Sub Timer()
   
2.     Dim Pos As Long, HHMM As Integer, col As Variant
   
3.         
   
4.     With Sheets("每分記錄")
   
5.         HHMM = Hour(Now) * 100 + Minute(Now)
   
6.         If (HHMM < 900 Or HHMM > 1333) Then Exit Sub
   
7.    
   
8.         .Cells(2, 4) = Now
   
9.         '  Time    6/21    6/21    6/22    6/22    6/23    6/23    6/24    6/24    6/25    6/25
   
10.         Set col = Range(.Range("A5"), .Cells(5, .[A5].End(xlToRight).Column)).Find(Format(.Cells(2, 4), "M/D"), LookIn:=xlValues, LookAt:=xlWhole)
    
11.         Pos = .Range("A" & Rows.Count).End(xlUp).Row + 1
    
12.         .Cells(Pos, 1) = Format(.Cells(2, 4), "HH:MM:SS")
    
13.         .Cells(Pos, col.Column) = .Cells(2, 2)
    
14.         .Cells(Pos, col.Column + 1) = .Cells(2, 3)
    
15.     End With
    
16.    
    
17.     '  Application.OnTime Now + TimeValue(LastMin), "ThisWorkbook.Timer"
    
18.     Application.OnTime Now + TimeValue("00:01:00"), "ThisWorkbook.Timer"
    
19. End Sub

複製代碼