f3202

1. Public uMode&, StartTime, EndTime
   
2. Public MyBook As Workbook, Sht1 As Worksheet, Sht2 As Worksheet, xRow&
   
3. Dim o As Single
   
4. Dim h As Single
   
5. Dim l As Single
   
6. Dim c As Single
   
7. Sub 共用參照()
   
8. Set MyBook = ThisWorkbook
   
9. Set Sht1 = MyBook.Sheets("Sheet1")
   
10. StartTime = "02:34:00"  '開盤時間（提早十秒開始，才可記錄開盤量價）"08:44:50"
    
11. EndTime = "23:59:50"    '收盤時間（延後十秒停止記錄）此為測試用時間，請自行更改正式時間 "13:45:10"
    
12. End Sub
    
13. Sub 自動記錄()
    
14. If uMode = 0 Then Exit Sub
    
15. If Time > TimeValue(EndTime) Then '收盤時間以後不執行
    
16.     Sht1.[J8] = "已過收盤"
    
17.     uMode = 0
    
18.     Exit Sub
    
19. End If
    
20. Sht1.Range("B8") = Time '當前時間（時間碼表）
    
21. If Second(Time) = 0 And Minute(Time) Mod 1 = 0 Then '每１分鐘記錄，５分鐘則改為 Mod 5
    
22. xRow = Sht1.Range("A65536").End(xlUp).Row + 1
    
23.   If xRow < 9 Then xRow = 9
    
24.    Sht1.Range("A" & xRow & ":I" & xRow).Value = Sht1.Range("A8:I8").Value
    
25.     o = 0: h = 0: l = 0: c = 0
    
26.      If ActiveSheet.Name = Sht1.Name And xRow > 20 Then
    
27.      ActiveWindow.ScrollRow = xRow - 10 '讓最新資料保持在可見視窗中
    
28. End If
    
29.    Beep
    
30. GoTo xxx
    
31. Else
    
32. c = Sheets("sheet1").Cells(5, 3)
    
33.    If c > h Then h = c
    
34.    If c < l Then l = c
    
35.    If o = 0 Then o = Sheets("sheet1").Cells(5, 3) Else o = o
    
36.    If l = 0 Then l = Sheets("sheet1").Cells(5, 3) Else l = l
    
37. Range("C8").Value = o
    
38. Range("d8").Value = h '填最高價
    
39. Range("e8").Value = l '填最低價
    
40. Range("f8").Value = c '填收盤價
    
41. xxx:
    
42.    ThisWorkbook.Save   '存檔
    
43. End If
    
44. Application.OnTime Now + TimeValue("00:00:01"), "自動記錄"
    
45. End Sub

複製代碼

試看看

f3202

回復 9# gery


    http://www.FunP.Net/388336