- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
7#
發表於 2015-11-19 18:58
| 只看該作者
回復 6# corcovado886
是這樣？- Sub 自動記錄()
- Dim cts As Integer, A As Range, Rng As Range
-
- If uMode = 0 Then Exit Sub
- If Time > TimeValue(EndTime) Then '收盤時間以後不執行
- Sht1.[W4] = "已過收盤"
- uMode = 0
- Exit Sub
- End If
- With Sht1
- .Range("W2") = Time '當前時間（時間碼表）
- '----------------------------------------------------------
- '每１分鐘記錄，５分鐘則改為 Mod 5
- If Second(Time) Mod 3 = 0 Then
- xRow = .Range("A65536").End(xlUp).Row + 1 '從最後一格往上尋找有資料的儲存格, 是在第幾列，然後再加1列
- If xRow < 11 Then xRow = 11 '如果列數小於11，則從第11列開始
- .Range("A" & xRow & ":V" & xRow).Value = .Range("A2:V2").Value
- .[B6:V6].ClearContents
- Set Rng = .[B6]
- cts = 0
- For Each A In .Range("A" & xRow & ":V" & xRow)
- cts = cts + 1
- If (A.Value >= 9) Then
- ' A.Font.Color = vbRed
- Rng.Value = .Range(Chr(64 + cts) & 10).Value
- Set Rng = Rng.Offset(, 1)
- Else
- ' A.Font.Color = vbBlack
- End If
- Next
- .Range("W" & xRow).Value = Time 'W欄位的時間值往下記錄
- '------------------------------------------------
- If ActiveSheet.Name = .Name And xRow > 20 Then
- ActiveWindow.ScrollRow = xRow - 11 ' 讓最新一筆資料保持在可見視窗中最底筆
- End If
- End If
- End With
- Application.OnTime Now + TimeValue("00:00:01"), "自動記錄" '每一秒遞迴一次
- End Sub
|
|
