小弟想寫個EXCEL VBA程式,一直搞不懂迴圈的寫法,煩請高手幫忙提供範例給予指導,感謝


觸發時間區間08:45:00 ~ 13:30:00

從08:45:00開始,每間隔10秒執行一次,複製某表格區間的內容貼上到指定表格區間

例:

08:45:00時,複製表格("B2:J2")的"值",貼上至表格("B5:J5")內

08:45:10時,複製表格("B2:J2")的"值",貼上至表格("B6:J6")內

08:45:20時,複製表格("B2:J2")的"值",貼上至表格("B7:J7")內

以此類推...直到13:30:00停止



小弟目前只能用土法煉鋼方法一行一行的寫,如下:(汗...),雖然也能達到我要的效果,但程式太過繁瑣,沒有效率,故發文請教簡化的寫法,謝謝。

Sub Auto_Open()
Application.OnTime TimeValue("8:45:00"),"Input_5"
Application.OnTime TimeValue("8:45:10"),"Input_6"
Application.OnTime TimeValue("8:45:20"),"Input_7"
End Sub

Sub Input_5()
Sheets(1).Range("B5:J5").Value = Sheets(1).Range("B2:J2").Value
End Sub

Sub Input_6()
Sheets(1).Range("B6:J6").Value = Sheets(1).Range("B2:J2").Value
End Sub

Sub Input_7()
Sheets(1).Range("B7:J7").Value = Sheets(1).Range("B2:J2").Value
End Sub
理論上應該這樣寫,用遞迴(看起來也不大像遞迴)而不是迴圈:

Dim 計數器 as Integer
計數器=0
Sub 自動複製()
if TimeValue(Now())=TimeValue("13:30:00") then exit sub
Sheets(1).Range("B" & 5+計數器 & ":J" & 5+計數器).Value = Sheets(1).Range("B2:J2").Value
計數器=計數器+1
Application.OnTime TimeValue("8:45:00")+TimeValue("00:00:10")*計數器,"自動複製"
End Sub

用迴圈的話,因為會一直執行,所以就不必使用Application.OnTime來設定下次觸發時間,只要一直檢查時間即可,像這樣:

Sub 自動複製()
Dim 計數器 as Integer
計數器=0
'迴圈開始
Do Until TimeValue(Now()) 大於等於 TimeValue("13:30:00") '不得不寫成中文的大於等於,不然會變成引用,請自己改掉
if Second(Now()) Mod 10=0 then '檢查是否為10的整倍數秒
Sheets(1).Range("B" & 5+計數器 & ":J" & 5+計數器).Value = Sheets(1).Range("B2:J2").Value
計數器=計數器+1
end if
DoEvents
Loop
End Sub

這種寫法的缺點是程式會一直執行、持續檢查時間,浪費了很多CPU的運算能力,必須加一行DoEvents讓出CPU處理能力,不然馬上卡死。

還有一個寫法是呼叫系統API來等待十秒

Sub 自動複製()
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '宣告使用系統API的Sleep函數
Dim 計數器 as Integer
計數器=0
Do Until TimeValue(Now()) 大於等於 TimeValue("13:30:00") '不得不寫成中文的大於等於,不然會變成引用,請自己改掉
Sheets(1).Range("B" & 5+計數器 & ":J" & 5+計數器).Value = Sheets(1).Range("B2:J2").Value
計數器=計數器+1
Sleep 10000 '等待10秒
Loop
End Sub

理論上是這樣寫,不過我沒測試過,如果有錯,請自行改寫。


light0935 wrote:
小弟想寫個EXCEL...(恕刪)
非常感謝您的幫忙,小弟再找時間測試,再上來報告
lordtaco wrote:
理論上應該這樣寫,用...(恕刪)
light0935 wrote:
小弟想寫個EXCEL VBA程式,一直搞不懂迴圈的寫法...(恕刪)


excel vba 如果等很多次、長時間的中斷
請不要用 for next 、do loop …等等的迴圈

sleep api 是更差的選擇,要等10秒這麼長的時間,根本不適合
等10秒,excel 就會停止回應10秒,需多加程式碼處理cpu佔用問題
不小心多點滑鼠多點幾次,windows 還會問您要不要終止程式

Application.OnTime 這個功能很特殊,在一些用法下就算使用 exit sub,它還是會繼續執行
建議改用 false 使它失效,比較安全
不過,如果時間到是存檔關閉excel,那就可以不用理它
還有 if 時間到,停止的判斷要放在最後面,不然資料會少最後一筆

請改用“連續呼叫副程式”的作法
可簡化程式碼,有效避免cpu被佔用、excel停止回應的問題

以下請參考,全部是基本指令applictaion.ontime 的應用,您一定看的懂的
像您這種願意先試著處理問題的,有問題再問吧,我會回答的

(程式碼簡化到6行)

Private Sub Workbook_Open()
Application.OnTime TimeValue("08:45:00"), "CopyData"
End Sub

'==============注意,以下請放在“模組”裡面============='
'=============這樣可簡化程式,少寫幾行程式碼==========='

Public RowCount As Integer

Sub CopyData()
On Error Resume Next
RowCount = RowCount + 1
Sheet1.Range("b" & 4 + RowCount & ":j" & 4 + RowCount).Value = Sheet1.Range("b2:j2").Value
Application.OnTime Now + TimeValue("00:00:10"), "CopyData"
If Time = TimeSerial(13, 30, 0) Then Application.OnTime Now + TimeValue("00:00:10"), "CopyData", , False

End Sub
'================================================


p.s 我發現最近很多人問跟“股票”有關的程式碼,很巧的是,時間點都非常接近
您們這幾位都認識嗎(分身??)公司Mis不幫忙嗎??
感謝您的幫忙 小弟會再測試,非常感謝
snare wrote:
excel vba...(恕刪)
lordtaco wrote:
如果有錯,請自行改寫...(恕刪)


確實3個都有錯,用您的程式碼親測過,非單純理論回答

範例1,timevalue 函數使用方式錯誤,無法執行
訂正後可執行,但需要其它程式碼呼叫副程式才能定時啟動,而且要放在模組才行

也需要程式碼來中斷application.ontime,最好不要用 exit sub
建議改用 application.ontime ..... false
因為在某些用法下,application.ontime 會一直在背景呼叫副程式不會停止
如果excel沒關閉,一段時間後,根據程式碼的不同
有可能產生溢位錯誤

範例2,
錯誤1:timevalue 函數使用方式錯誤,無法執行
還有一個 do loop 使用方式錯誤

cpu 使用率偏高不說,幾秒後,還會造成溢位錯誤,讓程式停止
雖然您有用if 判斷秒數是10才執行
但是 do loop 1秒可以執行數萬次以上

也就是說,在判斷為10的那1秒內,條件會成立數萬次
lordtaco wrote:
Sheets(1).Range("B" & 5+計數器 & ":J" & 5+計數器).Value = Sheets(1).Range("B2:J2").Value
計數器=計數器+1...(恕刪)

這2行也會執行數萬次
計數器,瞬間就溢位了,excel 瞬間被填滿一大堆資料

範例3,timevalue 函數使用方式錯誤,無法執行
訂正後可執行,但執行後效率極差,excel 幾乎是在無回應的狀態
Dear Snare大:

您內行的,小弟寫這程式是用來看期貨盤,跑RTD輔助判斷用的,不過您講的那些人我不知道,小弟是純粹自己研究用的

----------我是分隔線-----------------------------

Module1:

Sub Auto_Open()

If Time > TimeValue("08:45:00") Then

Copy_Data

End If

'為什麼不寫做 Application.OnTime TimeValue("08:45:00"), "Copy_Data",是因為後來發現若這樣寫,它只會在準時"08:45:00"才會觸發執行Sub Copy_Data(),若我超過時間才開Excel檔就不會Run了..

'2/24 06:09更新:發現新問題,我寫成 If Time > TimeValue("08:45:00") Then 時,若開檔時間是超過"08:45:00",它會Run,但若是在"08:45:00"前開啟檔案,當時間跨過去時,它是不會Run的,看來我需要理解一下該如何去述敘這一行程式

End Sub

----------我是分隔線-----------------------------

Module2:

Public RowCount1 As Integer '須放在"Sub Copy_Data"前面宣告

Sub Copy_Data()

RowCount1 = RowCount1 + 1

Sheets(1).Range("B" & 5 + RowCount1 & ":K" & 5 + RowCount1).Value = Sheets(1).Range("B2:K2").Value

Application.OnTime Now + TimeValue("00:00:10"), "Copy_Data" '間隔10秒更新一次

If Time > TimeSerial(13, 30, 0) Then Application.OnTime Now + TimeValue("00:00:10"), "Copy_Data", , False '設定,當目前時間大於13:30:00時,即停止執行

End Sub

----------我是分隔線-----------------------------

小弟參考了兩位的說明後,寫好程式如上,測試過可正常Run,尚未發現問題

但有個小小狀況...

因為小弟原本希望的是,08:45:00的資料會寫到欄位"B6:K6",然後08:45:10的資料會寫到欄位"B7:K7",以此類推下去...

正常情況下是不會有問題

但萬一過程中因故須重開Excel檔,假設當前時間是10:30:00,且我原先預設該時間的資料可能是寫在"B311:K:311"

但因為我重開檔案的關係,變成它又從頭於"B6:K6"一行一行的給它複寫下去,變成先前跑的資料就被洗掉了..

不知要怎麼改才能變成我想要的,請您再幫忙看看,謝謝。



最後,還是非常感謝Lordtaco及Snare兩位大的指導,小弟學到不少



light0935 wrote:
若開檔時間是超過"08:45:00",它會Run,但若是在"08:45:00"前開啟檔案,當時間跨過去時,它是不會Run的orz...(恕刪)

改成這樣就可以了

Private Sub Workbook_Open()
If Time > TimeValue("08:45:00") Then
copydata
else
Application.OnTime TimeValue("08:45:00"), "CopyData"
end if

End Sub


light0935 wrote:
但萬一過程中因故須重開Excel檔...(恕刪)


重開excel後要接著最後一筆資料,這個嘛…我先保留

提示,要多1行程式碼在workbook_open
RowCount = ????????

您先參考以前的這篇,做看看,我有回答,同類型的問題
http://www.mobile01.com/topicdetail.php?f=511&t=4682761&p=1#59037940
好的,我再研究看看,感謝您
snare wrote:
改成這樣就可以了Private...(恕刪)
範例3,timevalue 函數使用方式錯誤,無法執行
訂正後可執行,但執行後效率極差,excel 幾乎是在無回應的狀態


這應該是漏了一行DoEvents的關係,不過仔細想想,這樣寫似乎很不對勁,放棄這個方法好了。
關閉廣告
文章分享
評分
評分
複製連結

今日熱門文章 網友點擊推薦!