請各位先進幫忙 改我的VBA

junsean

之前朋友幫我寫的VBA
因為數據一有變化就會記錄
所以數據有時多有時少
我想每隔10秒記錄1次
但是我又是門外漢
所以想請各位先進幫幫忙   謝謝
Private Sub CommandButton1_Click()

End Sub

Private Sub Worksheet_Calculate()

If TimeValue(Format(Now, "hh:mm:ss")) <= TimeValue("08:44:00") Then
  
    Range("A2:J50000") = ""
   
Else

            
If TimeValue(Format(Now, "hh:mm:ss")) >= TimeValue("08:45:00") And TimeValue(Format(Now, "hh:mm:ss")) <= TimeValue("13:45:00") Then
   ar = Array([A1], [B1], [C1], [D1], [E1], [F1], [G1], [H1], [I1], [J1])
   [A65536].End(xlUp).Offset(1, 0).Resize(, 10) = ar
   
End If
End If
End Sub

oobird

Sub yy()
ar = Array([A1], [B1], [C1], [D1], [E1], [F1], [G1], [H1], [I1], [J1])
   [A65536].End(xlUp).Offset(1, 0).Resize(, 10) = ar
Application.OnTime Now + TimeSerial(0, 0, 10), "yy"
End Sub
放在module中。

junsean

謝謝oobird
我今天來試試

另外請問   如果
sheet1   想每隔10秒記錄1次
sheet2   想每隔1分鐘記錄1次

那要怎麼選module1    module2

oobird

你必須在代碼中指定工作表。
Sub yy()
with sheet1
ar = Array(.[A1], .[B1], .[C1], .[D1], .[E1], .[F1], .[G1], .[H1], .[I1], .[J1])
   .[A65536].End(xlUp).Offset(1, 0).Resize(, 10) = ar
Application.OnTime Now + TimeSerial(0, 0, 10), "yy"
end with
End Sub
---------------------------
Sub xx()
with sheet2
ar = Array(.[A1], .[B1], .[C1], .[D1], .[E1], .[F1], .[G1], .[H1], .[I1], .[J1])
   .[A65536].End(xlUp).Offset(1, 0).Resize(, 10) = ar
Application.OnTime Now + TimeSerial(0, 1, 0), "xx"
end with
End Sub

junsean

我試了
還是一樣  數據一有變動  就自動記錄
沒有間隔1分鐘1次

是我哪裡搞錯了嗎

我是這樣做
原本VBA的不動   再將oobird您教的
放在module1
這樣對嗎?

oobird

你原來的不刪掉一切白搭。

junsean

因為原來的會在
08:44:00以前刪除昨日的記錄
並且在
08:45:00到13:45:00自動記錄

如果刪掉原來的  不就沒有這些功能了
想上傳檔案
卻無法上傳

oobird

你須要的代碼可加在新的代碼裡呀！

junsean

Sub yy()

With Sheet1

If TimeValue(Format(Now, "hh:mm:ss")) <= TimeValue("08:59:00") Then
    Range("A3:I50000") = ""
   
Else
            
If TimeValue(Format(Now, "hh:mm:ss")) >= TimeValue("09:00:00") And TimeValue(Format(Now, "hh:mm:ss")) <= TimeValue("13:32:30") Then
   ar = Array([A2], [B2], [C2], [D2], [E2], [F2], [G2], [H2], [I2])
   [A65536].End(xlUp).Offset(1, 0).Resize(, 10) = ar
Application.OnTime Now + TimeSerial(0, 0, 10), "yy"

End If
End If
End With
End Sub

Sub xx()

With Sheet2

If TimeValue(Format(Now, "hh:mm:ss")) <= TimeValue("08:44:00") Then
    Range("A3:J50000") = ""
   
Else
            
If TimeValue(Format(Now, "hh:mm:ss")) >= TimeValue("08:45:00") And TimeValue(Format(Now, "hh:mm:ss")) <= TimeValue("13:45:00") Then
   ar = Array([A2], [B2], [C2], [D2], [E2], [F2], [G2])
   [A65536].End(xlUp).Offset(1, 0).Resize(, 7) = ar
Application.OnTime Now + TimeSerial(0, 0, 10), "xx"

End If
End If
End With
End Sub

junsean

像這樣子嗎

對不起   問題這麼多
因為我是真的門外漢
請多包涵