有什麼辦法可以加快我的宏嗎？

Question

我有一個宏，它將把列表中的每個值都放到不同的工作表（它執行自己的計算）並返回某些值（如彙總表）。我已經創建了一個循環宏來執行此操作，但由於列表中有大約6500個條目，因此宏執行速度非常緩慢。我關閉了屏幕更新，並且計算必須是自動的，所以我想知道：還有其他方法來加速宏嗎？

Sub watchlist_updated() 

Application.ScreenUpdating = False 

Range("A10").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.ClearContents 

Range("B10:Q10").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.ClearContents 

Sheets("Analysis").Select 
Range("C5:D5").ClearContents 
Range("N6").Select 
ActiveCell.FormulaR1C1 = "Yes" 

Sheets("Selected Data").Select 
Range("C6").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 

Sheets("Watchlist").Select 
Range("A10").Select 
ActiveSheet.Paste 
countermax = Selection.Count 

Range("A10").Select 
counter = 1 
Do Until ActiveCell = "" 
    sStatus = Format(counter/countermax, "0.0%") & " Complete" 
    Application.StatusBar = sStatus 
    Sheets("Analysis").Range("C5") = ActiveCell.Value 

Dim array1(16) 
Dim myrange As Range 

Set myrange = Range(ActiveCell.Offset(0, 1), ActiveCell.Offset(0, 16)) 

array1(0) = Sheets("Analysis").Range("F5").Value 
array1(1) = Sheets("Analysis").Range("C20").Value 
array1(2) = Sheets("Analysis").Range("J2").Value 
array1(3) = Sheets("Analysis").Range("B8").Value 
array1(4) = Sheets("Analysis").Range("J13").Value 
array1(5) = Sheets("Analysis").Range("R13").Value 
array1(6) = Sheets("Analysis").Range("C21").Value 
array1(7) = Sheets("Analysis").Range("B11").Value 
array1(8) = Sheets("Analysis").Range("V5").Value 
array1(9) = Sheets("Analysis").Range("B12").Value 
array1(10) = Sheets("Analysis").Range("J6").Value 
array1(11) = Sheets("Analysis").Range("B9").Value 
array1(12) = Sheets("Analysis").Range("N20").Value 
array1(13) = Sheets("Analysis").Range("H23").Value 
array1(14) = Sheets("Analysis").Range("F23").Value 
array1(15) = Sheets("Analysis").Range("D23").Value 

myrange = array1 

    ActiveCell.Offset(1, 0).Select 

counter = counter + 1 
Loop 

Application.StatusBar = False 
Sheets("Analysis").Select 
Range("N6").Select 
ActiveCell.FormulaR1C1 = "No" 
Sheets("Watchlist").Select 
Application.ScreenUpdating = True 

Application.StatusBar = False 

End Sub 

Answer 1

雖然這不會加速整個事情。您可以通過擺脫'選擇/選擇'位來節省時間。

例如對於第一部分取代：

Range("A10").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.ClearContents 

與：

Range([A10],[A10].End(xlDown)).ClearContents 

注意：在這種情況下使用[]取代範圍（）。使用這個快捷方式並不總是健康的，但爲了您的目的，它應該沒問題。 你應該總是試着重寫一下你之前用這種格式記錄的代碼，它會繞過宏錄像機的笨拙，並將其變成整潔的vba代碼:)

Answer 2

它不是很漂亮，但速度很快。讓Array更快，但我不太擅長，但這可能是一種替代解決方案。

Sub watchlist_updated() 

'***Define your Variables*** 
Dim wsAnalysis As Excel.Worksheet 
Dim wsWatchList As Excel.Worksheet 
Dim wsSelectData As Excel.Worksheet 
Dim LastRow1 As Long 
Dim LastRow2 As Long 
Dim LastRow3 As Long 

'***Set the objects*** 
Set wsAnalysis = Sheets("Analysis") 
Set wsWatchList = Sheets("Watchlist") 
Set wsSelectData = Sheets("Selected Data") 

'***Turn off Background*** 
Application.DisplayAlerts = False 
Application.EnableEvents = False 
Application.ScreenUpdating = False 

'***Finding Last Row - Each Sheet*** 
LastRow1 = wsSelectData.Range("C" & Rows.Count).End(xlUp).Row 
LastRow2 = wsAnalysis.Range("A" & Rows.Count).End(xlUp).Row 
LastRow3 = wsWatchList.Range("C" & Rows.Count).End(xlUp).Row 

'***Handle any Errors*** 
On Error GoTo ErrorHandler: 

With wsWatchList 
    .Range(.Cells(10, 1), .Cells(10 + LastRow3, 17)).ClearContents 
End With 

With wsAnalysis 
    .Range("C5:D5").ClearContents 
    .Range("N6").FormulaR1C1 = "Yes" 
End With 

'***New Copy & Paste Method*** 
wsWatchList.Range(wsWatchList.Cells(10, 1), wsWatchList.Cells(10 + LastRow1, 1)).Value = _ 
wsSelectData.Range(wsSelectData.Cells(6, 3), wsSelectData.Cells(6 + LastRow1, 3)).Value 

wsAnalysis.Range("C5") = LastRow1 - 5 

wsWatchList.Range(wsWatchList.Cells(10, 2), wsWatchList.Cells(LastRow1 + 4, 2)).Value = wsAnalysis.Range("F5").Value 
wsWatchList.Range(wsWatchList.Cells(10, 3), wsWatchList.Cells(LastRow1 + 4, 3)).Value = wsAnalysis.Range("C20").Value 
wsWatchList.Range(wsWatchList.Cells(10, 4), wsWatchList.Cells(LastRow1 + 4, 4)).Value = wsAnalysis.Range("J2").Value 
wsWatchList.Range(wsWatchList.Cells(10, 5), wsWatchList.Cells(LastRow1 + 4, 5)).Value = wsAnalysis.Range("B8").Value 
wsWatchList.Range(wsWatchList.Cells(10, 6), wsWatchList.Cells(LastRow1 + 4, 6)).Value = wsAnalysis.Range("J13").Value 
wsWatchList.Range(wsWatchList.Cells(10, 7), wsWatchList.Cells(LastRow1 + 4, 7)).Value = wsAnalysis.Range("C21").Value 
wsWatchList.Range(wsWatchList.Cells(10, 8), wsWatchList.Cells(LastRow1 + 4, 8)).Value = wsAnalysis.Range("B11").Value 
wsWatchList.Range(wsWatchList.Cells(10, 9), wsWatchList.Cells(LastRow1 + 4, 9)).Value = wsAnalysis.Range("V5").Value 
wsWatchList.Range(wsWatchList.Cells(10, 10), wsWatchList.Cells(LastRow1 + 4, 10)).Value = wsAnalysis.Range("B12").Value 
wsWatchList.Range(wsWatchList.Cells(10, 11), wsWatchList.Cells(LastRow1 + 4, 11)).Value = wsAnalysis.Range("J6").Value 
wsWatchList.Range(wsWatchList.Cells(10, 12), wsWatchList.Cells(LastRow1 + 4, 12)).Value = wsAnalysis.Range("B9").Value 
wsWatchList.Range(wsWatchList.Cells(10, 13), wsWatchList.Cells(LastRow1 + 4, 13)).Value = wsAnalysis.Range("N20").Value 
wsWatchList.Range(wsWatchList.Cells(10, 14), wsWatchList.Cells(LastRow1 + 4, 14)).Value = wsAnalysis.Range("H23").Value 
wsWatchList.Range(wsWatchList.Cells(10, 15), wsWatchList.Cells(LastRow1 + 4, 15)).Value = wsAnalysis.Range("F23").Value 
wsWatchList.Range(wsWatchList.Cells(10, 16), wsWatchList.Cells(LastRow1 + 4, 16)).Value = wsAnalysis.Range("D23").Value 


wsAnalysis.Range("N6").FormulaR1C1 = "No" 

wsWatchList.Select 

'***Clean Up*** 
BeforeExit: 

Set wsAnalysis = Nothing 
Set wsWatchList = Nothing 
Set wsSelectData = Nothing 

'***Turn on Background*** 
Application.DisplayAlerts = True 
Application.EnableEvents = True 
Application.ScreenUpdating = True 

Exit Sub 
'***Add in a simple ErrorHandler*** 
ErrorHandler: 

MsgBox "Error" 

GoTo BeforeExit 

End Sub 

希望這有助於！

Answer 3

快速VBA循環的關鍵是最小化與循環內工作簿的交互。

在你的情況下，你將無法完全消除交互，但你可以大幅度減少交互。

關鍵步驟是：

1. 您可以用手工計算。 （見下文）
2. 創建Worksheet和Range對象變量來指向你的牀單和範圍
3. 創建變量數組的握住你的源數據，結果數據和分析結果
4. 一旦你有你的源數據的引用，將其複製到Variant數組中。做一個For循環移到該陣列的行（而不是使用ActiveCell）
5. 創建結果陣列，尺寸以源數據的行，由16列寬
6. 在每次迭代中，源數據值複製到分析片（這裏的地方你不能避免一些工作簿交互）
7. 強制分析表的重新計算與wsAnalysis.Calculate
8. 複製的結果，一個變量數組中的一個步驟。我想複製範圍A1:V23。（一次複製太多單元比一次複製一個單元更快）
9. 將所需結果映射到您的結果數組中，放入當前行
10. 循環後，將結果數組複製到結果範圍在您的工作簿（再一步）

其他說明：

1. 消除所有的Select，Selection，ActiveSheet，ActiveCell的東西（如其他人所說的）
2. 聲明所有的變量
3. 要明確的上限和下限在你的數組聲明
4. 提供錯誤處理程序，並清理代碼打開Application性能，即使代碼錯誤

畢竟這，性能將取決於您的Analysis工作表的計算時間。可能還有機會進行改進，如果你願意分享它的細節