a8350070

試著在變動幅度最小的前提下修改

Option Explicit
Dim LastMin As Long

Private Sub Workbook_Open()
    Sheets("策略記錄").Cells(4, 2) = 10
    LastMin = Hour(Time) * 3600 + Minute(Time) * 60 + Second(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 Hour(Time) * 3600 + Minute(Time) * 60 + Second(Time) > LastMin + 30 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 = Hour(Time) * 3600 + Minute(Time) * 60 + Second(Time)
    End If
End Sub

c_c_lai

回復 9# xu123

下載 (49.39 KB)

2012-5-26 11:32

1. Option Explicit
   
2. Dim LastMin As String          ' 更改為間隔時段設定
   
3. 
   
4. Private Sub Workbook_Open()
   
5.     Sheets("策略記錄").Cells(4, 2) = 10     ' 保留你之前的設定，每次一開啟Excel都重新開始
   
6.     LastMin = "00:00:30"          ' 每隔 30 秒的時段設定。如需以一分鐘做處哩，則請修正為 "00:01:00"
   
7.    
   
8.     Call Timer
   
9. End Sub
   
10. 
    
11. Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
12.     On Error Resume Next
    
13.     Application.OnTime Now + TimeValue("00:00:01"), "ThisWorkbook.Timer", , False
    
14. End Sub
    
15. 
    
16. 
    
17. Public Sub Timer()
    
18.     Dim Pos, i, HHMM As Integer, RangeStr As String
    
19.         
    
20.     On Error Resume Next
    
21.     Sheets("策略記錄").Cells(3, 2) = Time '將時間show至策略的b3欄位
    
22.    
    
23.     HHMM = Hour(Time) * 100 + Minute(Time)
    
24.     If (HHMM < 845 Or HHMM > 1345) Then Exit Sub '營業時間才執行
    
25.         
    
26.     With Sheets("策略記錄")
    
27.         .Cells(4, 2) = .Cells(4, 2) + 1 '將變動行號加一行
    
28.         Pos = .Cells(4, 2)
    
29.         .Cells(Pos, 1) = Time
    
30.         .Cells(Pos, 2) = .Cells(2, 2)
    
31.         .Cells(Pos, 3) = .Cells(2, 3)
    
32.         .Cells(Pos, 4) = .Cells(2, 4)
    
33.         .Cells(Pos, 5) = .Cells(2, 5)
    
34.         .Cells(Pos, 6) = .Cells(2, 6)
    
35.         .Cells(Pos, 7) = .Cells(2, 7)
    
36.         .Cells(Pos, 8) = .Cells(2, 8)
    
37.         .Cells(Pos, 9) = .Cells(2, 9)
    
38.         .Cells(Pos, 10) = .Cells(2, 10)
    
39.     End With
    
40.    
    
41.     Application.OnTime Now + TimeValue(LastMin), "ThisWorkbook.Timer"  ' 每 LastMin 執行一次
    
42. End Sub

複製代碼

祝星期假日愉快！
自動記錄每分鐘委買賣均值-範例.rar (12.31 KB)

下載次數: 99

2012-5-26 11:38

xu123

測試可以使用了
謝謝a8350070  和c_c_lai
你們真的很熱心

GaryC

初來到這裡 真是高手如雲
看來可得好好學習了

usana642

感謝c_c_lai 大這麼詳細用心的解說

usana642

謝謝a8350070  和c_c_lai 用心的解說

mead

試著在變動幅度最小的前提下修改

Option Explicit
Dim LastMin As Long

Private Sub Workbook_Open ...
a8350070 發表於 2012-5-26 11:03

If Hour(Time) * 3600 + Minute(Time) * 60 + Second(Time) > LastMin + 30 Then '開始後做
這樣改  其要記錄的時間設定要減1
如30秒  就要加29而非30

c_c_lai

回復 17# mead
附上一個可以隨你需求異動的 "自動記錄每分鐘委買賣均值"，
以後你就沒有煩惱的事了！
自動記錄每分鐘委買賣均值.rar (13.96 KB)

下載次數: 84

2012-6-25 07:55

P.S. 請將 Time() 裡的             .Cells(21, 2).Offset(0).Resize(, 9) = .[B12:J12].Value
更改成                                      .Cells(Pos, 2).Offset(0).Resize(, 9) = .[B2:J2].Value

c_c_lai

回復 19# mead
找到了，已  E-Mail 過去了！

usana642

回復 20# c_c_lai


    c_c_lai 大大,我也需要這個檔案,因權限不足無法下載
可否寄到我的信箱,感謝熱心分享