- 帖子
- 85
- 主題
- 26
- 精華
- 0
- 積分
- 65
- 點名
- 0
- 作業系統
- WINXP
- 軟體版本
- SP3
- 閱讀權限
- 20
- 註冊時間
- 2015-7-15
- 最後登錄
- 2018-9-18
|
10#
發表於 2015-8-4 15:12
| 只看該作者
本帖最後由 daniel5168 於 2015-8-4 15:18 編輯
回復 8# GBKEE
多謝GBKEE 版主幫忙解答,經過您的編寫,我亂改出問題,lpk187大大的指點,我再亂改,終於測試成功
- Public uMode&, StartTime, EndTime
- Public MyBook As Workbook, Sht1 As Worksheet, Sht2 As Worksheet, xRow&
- Sub 共用參照()
- Set MyBook = ThisWorkbook
- Set Sht1 = MyBook.Sheets("台指近一分鐘線")
- StartTime = "08:44:50" '開盤時間（提早十秒開始，才可記錄開盤量價）"08:44:50"
- EndTime = "21:45:10" '收盤時間（延後十秒停止記錄）此為測試用時間，請自行更改正式時間 "13:45:10"
- End Sub
- Sub 自動記錄()
- Dim Rng As Range, 漲跌 As Single, 均價 As Single
- If uMode = 0 Then Exit Sub
- With Sht1
- If Time > TimeValue(EndTime) Then '收盤時間以後不執行
- .[F2] = "已過收盤"
- uMode = 0
- Exit Sub
- End If
- Sht1.Range("B2") = Time '當前時間（時間碼表）
- '----------------------------------------------------------
- '每１分鐘記錄，５分鐘則改為 Mod 5
- If Second(Time) = 0 And Minute(Time) Mod 1 = 0 Then
- Set Rng = .Range("A65536").End(xlUp).Offset(1)
- .Range("A" & Rng.Row & ":C" & Rng.Row).Value = .Range("A2:C2").Value
- With .Cells(Rng.Row, "C") '
- '漲跌的定義應該是(這分鐘成交價-上分鐘成交價)/上分鐘成交價
- If .Row >= 4 Then 漲跌 = (.Cells - .Cells.Offset(-1))
- '20單位週期均價
- If .Row >= 22 Then 均價 = Application.WorksheetFunction.Average(.Cells.Offset(-19).Resize(20))
- End With
- .Range("D2") = IIf(漲跌 <> 0, 漲跌, "")
- .Range("E2") = IIf(均價 <> 0, 均價, "")
- .Range("D" & Rng.Row & ":E" & Rng.Row).Value = .Range("D2:E2").Value
- End If
- '------------------------------------------------
- End With
- If ActiveSheet.Name = Sht1.Name And xRow > 8 Then
- ActiveWindow.ScrollRow = xRow - 6 '讓最新資料保持在可見視窗中
- End If
- Beep
- '------------------------------------------------
- ThisWorkbook.Save '存檔
- Application.OnTime Now + TimeValue("00:00:01"), "自動記錄" '每一秒遞迴一次
- End Sub
- Sub 開始執行()
- If uMode = 1 Then Exit Sub
- Call 共用參照
- uMode = 1
- Sht1.[F2] = "執行中"
- Call 自動記錄
- End Sub
- Sub 停止執行()
- uMode = 0
- Call 共用參照
- Sht1.[F2] = "STOP"
- End Sub
- Sub 清除記錄資料()
- Beep
- If MsgBox("※確定要清除〔Sheet1〕的記錄嗎？ ", 4 + 32 + 256) = vbNo Then Exit Sub
- Call 共用參照
- Sht1.Rows("3:65536").ClearContents
- If ActiveSheet.Name = Sht1.Name Then ActiveWindow.ScrollRow = 1
- Beep
- End Sub
|
|
發表於 2015-8-3 16:07
| 
