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

為了縮短方案的工作時間，小妹自己看書學做vba程式，
這個程式是將總表中的資料分類到各表去，
人數少的時候跑得快，但只要超過300人以上程式就要跑2-3分鐘，甚至更久......上司是無法等待這麼久的時間才看到結果。
小妹才學粗淺，想請教的問題為:
1. 是否有能夠縮短跑vba程式的時間? 讓資料更快速的分類完畢?
2. 程式在分類的時候，不會偵測各表已有舊資料，反而直接從下方空白處重複貼上，造成各表的資料有多筆重複。
請問是否有辦法在分類時，讓各表自動判斷資料是否有重複存在，只要在空白處新增新的幾筆資料即可?

在此感謝各位高手、大大不吝指教，萬分感謝~

測試檔.rar (61.12 KB)

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2831
主題: 10
精華: 0
積分: 2887
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-5

2^#

發表於 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

minarabbit

中學生 Rank: 2

帖子: 8
主題: 3
精華: 0
積分: 61
點名: 0
作業系統: Microsoft Windows
軟體版本: office 2010
閱讀權限: 20
註冊時間: 2018-12-26
最後登錄: 2023-6-13

3^#

發表於 2019-10-27 16:39 | 只看該作者

回復 2# 准提部林

感謝大大的教導和語法!!

用了Application.ScreenUpdating = False的指令可以加快程式跑的速度，原本300人要1-2分鐘左右，已縮減至40秒就跑完了。
但是用了大大提供的【篩選和Intersect】語法，反而程式分類和速度更快! 短短3-4秒就跑完了!!
原來差別在於書中教的"迴圈"會導致分類速度很慢...

以前用過篩選來分類過資料，當時是用一個考科、一個按鈕搭配一個篩選及複製指令，導致vba模組顯得有些雜亂。
本以為用書中所教的分類語法會比一個一個篩選來得好，沒想到回頭來用篩選語法才是最適合的。

再次感謝大大，上了寶貴的一課!

TOP