- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
3#
發表於 2013-10-25 09:55
| 只看該作者
本帖最後由 c_c_lai 於 2013-10-25 09:57 編輯
回復 1# shing0520
1. 首先妳開啟 "股票報價數據自動記錄.xlsx" 檔案後，將它另存新檔
存檔類型請選擇 "Excel 啟用巨集的活頁簿 (*.xlsm)" 、或者
"Excel 97-2003 活頁簿 (*.xls) " 的檔案型態。
2. 請將下列程式碼全部剪貼至 ThisWorkbook 程式碼區塊內儲存：- Option Explicit
- Private Sub Workbook_Open()
- If Weekday(Date, 2) <= 5 Then Scheduler ' 非假日則執行 Scheduler
- End Sub
- Sub RTimer()
- Dim TimeRange As Range, Rng As Range
- Dim tm As Date
- If TimeValue(Now) >= TimeValue("13:45:01") Then Exit Sub ' 一過盤後即自行跳離，不再執行
-
- tm = Now()
- With Sheets("連結時間記錄")
- Set TimeRange = .[A:A].Find(TimeSerial(Hour(tm), Minute(tm), 0)) ' 檢查 "A" 欄位對應之時間資料
- If Not TimeRange Is Nothing Then ' 吻合預先排程時段，則執行對稱寫入資料
- Set Rng = TimeRange.Offset(, 1).Resize(1, 2)
-
- Rng(1) = .[I2] ' 漲幅%
- Rng(2) = .[G2] ' 成交
- End If
- End With
- Scheduler
- End Sub
- Sub Scheduler()
- If TimeValue(Now) < TimeValue("08:45:00") Then
- Application.OnTime (TimeValue("08:45:00")), "ThisWorkbook.RTimer" ' 8:45 時間一到會自動執行
- Else
- Application.OnTime (Now + TimeValue("00:00:01")), "ThisWorkbook.RTimer" ' 每隔一分鐘搜尋一次
- End If
- End Sub
4. 在程式中我加註了一些說明，希望對妳會有所幫助。祝愉快！ |
|
