- 帖子
- 522
- 主題
- 36
- 精華
- 1
- 積分
- 603
- 點名
- 0
- 作業系統
- win xp sp3
- 軟體版本
- Office 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-12-13
- 最後登錄
- 2021-7-11
|
13#
發表於 2017-2-23 09:43
| 只看該作者
本帖最後由 yen956 於 2017-2-23 09:46 編輯
回復 12# peter95
是的, 每2分鐘檢查一次和延後2分鐘記錄的確不一樣,
有可能每個檢查點都是低點,而錯過高點
替代方案:
新增暫存表 sheet4, 將 Worksheet_Calculate 的結果全部暫放暫存表 sheet4,
再每2分鐘從暫存表 sheet4 中選取 [C13] 最高值那列
複製到 Sheet3, 如何?
'放Module
'借用 Hsieh版大的 onTime, 請放在 Module
'http://forum.twbts.com/thread-19283-1-2.html
'從早上8點到下午5點每2分鐘執行 "Copy_test" 1次
Sub OnTime_test()
Dim t
For t = TimeValue("08:00:00") To TimeValue("17:00:00") Step TimeValue("00:02:00")
Application.OnTime t, "Copy_test"
Next
End Sub
Sub Copy_TEST()
Dim LstR3 As Integer, LstR4 As Integer, sh3 As Object, sh4 As Object
Set sh3 = Sheets("Sheet3")
Set sh4 = Sheets("Sheet4")
LstR3 = sh3.[A65536].End(xlUp).Row + 1 '取得 "Sheet3" 欄A最下面非空白格的下一格 的列號
LstR4 = sh4.[A65536].End(xlUp).Row '取得 "Sheet4" 欄F最下面非空白格的列號
If sh4.[A1] = "" Then Exit Sub
'按 sh4.[F1] 降冪排序
sh4.[A1].Resize(LstR4, 6).Select
Selection.Sort _
Key1:=sh4.[F1], Order1:=xlDescending, _
Header:=xlNo
sh4.[A1].Resize(1, 4).Copy sh3.Cells(LstR3, 1)
'清除sheet4, 重新供 Worksheet_Calculate 暫存
sh4.Cells() = ""
End Sub
'下面同樣放 Sheet2
Private Sub Worksheet_Calculate()
Dim Rng As Range, LstR As Integer, sh4 As Object
Set sh4 = Sheets("Sheet4")
If Not Application.IsNumber([C13]) Then Exit Sub '沒資料就跳出
LstR4 = sh4.[A65536].End(xlUp).Row '取得 "Sheet4" 欄A最下面非空白格的列號
If [C13] > 50 Then
[A17].Resize(1, 4).Copy
sh4.Cells(LstR4, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
[C13].Copy '[C13]的值也保留到Sheet4欄F
sh4.Cells(LstR4, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
End Sub |
|
