麻辣家族討論版版 - Powered by Discuz! Board

標題: 請各位先進幫忙改我的VBA [打印本頁]

作者: junsean 時間: 2010-10-18 21:33 標題: 請各位先進幫忙改我的VBA

之前朋友幫我寫的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 時間: 2010-10-18 23:27

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 時間: 2010-10-19 08:28

謝謝oobird
我今天來試試

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

那要怎麼選module1 module2

作者: oobird 時間: 2010-10-19 08:44

你必須在代碼中指定工作表。
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 時間: 2010-10-19 12:20

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

是我哪裡搞錯了嗎

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

作者: oobird 時間: 2010-10-19 12:59

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

作者: junsean 時間: 2010-10-19 17:12

本帖最後由 junsean 於 2010-10-19 20:46 編輯

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

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

作者: oobird 時間: 2010-10-19 20:43

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

作者: junsean 時間: 2010-10-19 21:02

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 時間: 2010-10-19 21:04

像這樣子嗎

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

作者: GBKEE 時間: 2010-10-19 21:40

本帖最後由 GBKEE 於 2010-10-19 21:45 編輯

回復 10# junsean
If Time <= TimeValue("08:59:00") Then
   Range("A3:I50000") = ""                '第一次條件成立時執行如此
ElseIf  Time >= TimeValue("09:00:00") And Time <= TimeValue("13:32:30") Then
      ar = Array([A2], [B2], [C2], [D2], [E2], [F2], [G2], [H2], [I2])  '只有9個元素
      [A65536].End(xlUp).Offset(1, 0).Resize(, 10) = ar
      Application.OnTime Time + TimeSerial(0, 0, 10), "yy"    '這裡就不執行了
End If

Sub yy()
With Sheet1
If Time <= TimeValue("08:59:00") Then
.Range("A3:I50000") = ""
Application.OnTime TimeSerial(9, 0, 0), "yy"
End If
If Time >= TimeValue("09:00:00") And Time <= TimeValue("13:32:30") Then
ar = Array(.[A2], .[B2], .[C2], .[D2], .[E2], .[F2], .[G2], .[H2], .[I2],.[J2])
.[A65536].End(xlUp).Offset(1, 0).Resize(, 10) = ar
Application.OnTime Time + TimeSerial(0, 0, 10), "yy"
End If
End With
End Sub
Sub xx()
With Sheet2
If Time <= TimeValue("08:44:00") Then
.Range("A3:J50000") = ""
Application.OnTime TimeSerial(9, 0, 0), "xx"
End If
If Time >= TimeValue("08:45:00") And Time <= 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 Time + TimeSerial(0, 1, 0), "xx"
End If
End With
End Sub

複製代碼

作者: junsean 時間: 2010-10-19 22:20

謝謝GBKEE
我明天試試看

另外
一定要放在module嗎 ?

作者: GBKEE 時間: 2010-10-20 06:51

回復 12# junsean
如不是在模組需指明出處
Application.OnTime TimeSerial(9, 0, 0), "SHEET1.yy"
Application.OnTime TimeSerial(9, 0, 0), "SHEET2.XX"

作者: junsean 時間: 2010-10-20 09:20

可以10秒記錄一次了
可是怎麼沒按F5不會自動執行

因為我
期貨每10秒記錄一次
加權每1分鐘記錄一次

去看加權時都沒記錄
才按F5就開始記錄

好奇怪

作者: GBKEE 時間: 2010-10-20 09:36

回復 14# junsean
附檔來看看

作者: junsean 時間: 2010-10-20 09:58

關掉excel又自動開
一直都關不掉

作者: GBKEE 時間: 2010-10-20 10:15

關掉excel又自動開一直都關不掉
junsean 發表於 2010-10-20 09:58

關掉整個 Excel 程式 APPLICATION.ONTIME 才會停止

作者: junsean 時間: 2010-10-20 10:36

可以
sheet1寫一個程式碼
sheet2寫一個程式碼?
因為我最早是這樣用的

作者: junsean 時間: 2010-10-20 10:55

我舊的檔案

作者: GBKEE 時間: 2010-10-20 10:56

回復 18# junsean
再加上 Sub AUTO_OPEN() 存檔後每次再開啟就可以

Sub AUTO_OPEN()
yy
xx
End Sub

複製代碼

作者: junsean 時間: 2010-10-20 18:46

謝謝GBKEE

也是放在模組嗎

作者: GBKEE 時間: 2010-10-20 19:03

回復 21# junsean
對的
或是在ThisWorkbook 模組的 Private SubWorkbook_Open() 也可以

Private Sub Workbook_Open()
yy
xx
End Sub

複製代碼

作者: junsean 時間: 2010-10-20 19:36

感恩GBKEE
還有oobird
謝謝你們

作者: junsean 時間: 2010-10-21 09:23

今天試用可以用了
可是每次都記錄3筆(同樣的數據)
好奇怪
不是每次記錄1筆嗎

請各位大大幫幫小弟謝謝

作者: GBKEE 時間: 2010-10-21 11:20

回復 24# junsean
附檔來看看

作者: junsean 時間: 2010-10-21 19:44

附檔

麻煩您了

今天大部分是
一次記錄3筆重複的數據

作者: GBKEE 時間: 2010-10-21 21:36

回復 26# junsean
一次記錄3筆重複的數據不會呀! 會不會是你的數據沒有變動的錯覺.
已加上時間欄,你現在到23:45:00前可測試看看.

Sub yy()
With Sheet1
If Time <= TimeValue("08:44:50") Then
.Range("A3:G50000") = ""
Application.OnTime TimeSerial(8, 45, 0), "yy"
End If
If Time >= TimeValue("08:45:00") And Time <= TimeValue("23:45:00") Then
ar = Array(.[A2], .[B2], .[C2], .[D2], .[E2], .[F2], .[G2], Time)
.[A65536].End(xlUp).Offset(1, 0).Resize(, 8) = ar
Application.OnTime Time + TimeSerial(0, 0, 10), "yy"
End If
End With
End Sub
Sub xx()
With Sheet2
If Time <= TimeValue("08:59:50") Then
.Range("A3:J50000") = ""
Application.OnTime TimeSerial(9, 0, 0), "xx"
End If
If Time >= TimeValue("09:00:00") And Time <= TimeValue("23:32:10") Then
ar = Array(.[A2], .[B2], .[C2], .[D2], .[E2], .[F2], .[G2], .[H2], .[I2], .[J2], Time)
.[A65536].End(xlUp).Offset(1, 0).Resize(, 11) = ar
Application.OnTime Time + TimeSerial(0, 1, 0), "xx"
End If
End With
End Sub

複製代碼

作者: junsean 時間: 2010-10-21 21:54

應該不是錯覺

請看今天記錄的圖

作者: junsean 時間: 2010-10-21 22:07

測試ok

可是盤中真的一次記錄3筆
我明天再試試

謝謝GBKEE

作者: junsean 時間: 2010-10-22 21:44

今天終於可以用了

太感謝您了GBKEE

還有oobird
也要謝謝您

作者: skyage 時間: 2010-12-3 09:41

Worksheet_Calculate() <==== 問題在這邊, dde 數據一改變就會觸發下面的程式碼
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

所以你要的間格時間無效
清空後, 就不會一直跑(或著你可以在原代碼中增加時間判斷 10sec,60sec 要執行的事項)

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)