有什么办法可以加快我的宏吗？

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工作表的计算时间。可能还有机会进行改进，如果你愿意分享它的细节