- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 3# jackson184
如圖 插入一模組 將下列兩程序貼上
- Option Explicit '在模組層次中強迫每個在模組�堛瘍僂くㄔ眸楨�確的宣告。
- Dim Rng As Range ' 通用於模組(Module) 內的私用變數
- Private Sub AUTO_OPEN() '此巨集於檔案開啟時會自動執行
- With Sheets("90")
- .UsedRange.Offset(1).Clear '清除 前一日的數據
- Set Rng = .Range("A2:A31,F2:F31,K2:K31") '數據傳回的區域,為多重範圍.
- End With
- If Time < TimeValue("08:45") Then '早於開盤時間
- Application.OnTime TimeValue("08:45"), "MyDee" '設定於08:45 執行 MyDee 程序
- ElseIf Time >= TimeValue("08:45") And Time <= TimeValue("13:30") Then '於交易時間內
- MyDee ' 執行 MyDee 程序
- End If
- End Sub
- Private Sub MyDee()
- Dim A As Integer, Ar(), R As Integer, C As Integer
- If Time > TimeValue("13:30") Then Exit Sub ' 收盤時間後 停止執行
- A = Application.CountA(Rng) '計算 (數據傳回的區域)有資料儲存格的總數
- If A <= 29 Then C = A + 1 'C 為 數據傳回的區域的列位
- If A Mod 30 >= 0 Then C = (A Mod 30) + 1
- R = Int(A / 30) + 1 'R 為多重範圍的第幾個範圍
- With Sheets("連結")
- Ar = Array(Now, A + 1, .Range("I2"), .Range("J2"))
- 'Ar 為取得 1. 時間, 2.項次,3.最高價 ,4,最低價 '找不到 -> 收盤價找不到
- 'Ar = Array(Now, A + 1, .Range("I2"), .Range("J2"), 收盤價 ) '有收盤價
- End With
- Rng.Areas(R).Cells(C).Resize(1, 4) = Ar
- 'Rng.Areas(R).Cells(C).Resize(1, 5) = Ar '有收盤價
- Application.OnTime Now + TimeValue("00:10"), "MyDee" '設定 10分後 執行 MyDee 程序
- End Sub
複製代碼 |
|