返回列表 上一主題 發帖

[發問] 請教高手如何縮減跑vba的時間

准提部林

帖子
2798 
主題
10 
精華
0 
積分
2854 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-4-20 
1# 跳轉到 »
發表於 2019-10-27 09:44 | 顯示全部帖子
用原來的程式碼, 300人也不須花多久時間, 在開頭加入:
Application.ScreenUpdating = False
即可加快~~

=======================================
先用[篩選]方法試試:
註：程式碼並未自動產生工作表, 若有其它科目, 須自行手動建立科目工作表,
　　並在 Array("英文科", "歷史科", "物理科") 中增加科目名稱

Sub 成績表分類()
Dim Sht As Worksheet
For Each Sht In Sheets(Array("英文科", "歷史科", "物理科"))
    Intersect(Sht.[A:G], Sht.UsedRange).Offset(1, 0).ClearContents '清除內容
    With Intersect(Sheets("成績表").[A:F], Sheets("成績表").UsedRange)
         .AutoFilter Field:=3, Criteria1:=Sht.Name '以工作表名稱篩選
         .Columns(1).Offset(1, 0).Resize(, 6).Copy Sht.[A2] '複製A~E欄
         .Columns(6).Offset(1, 0).Copy Sht.[G2] '複製備註欄
    End With
Next
Sheets("成績表").AutoFilterMode = False
End Sub

Sub 清空本表()
Intersect([A:G], ActiveSheet.UsedRange).Offset(1, 0).ClearContents
End Sub

Sub 清空各分類表()
Dim Sht As Worksheet
For Each Sht In Sheets(Array("英文科", "歷史科", "物理科"))
    Intersect(Sht.[A:G], Sht.UsedRange).Offset(1, 0).ClearContents
Next
End Sub


＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

TOP

        靜思自在 : 要用心，不要操心、煩心。
返回列表 上一主題