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

快速VBA循环的关键是最小化与循环内工作簿的交互。

在您的情况下，您无法完全消除互动，但您可以大幅减少互动。

关键步骤是：

你可以使用手动计算。（见下文）
创建Worksheet和Range个对象变量以引用您的工作表和范围
创建变体数组以保存源数据，结果数据和分析结果
获得对源数据的引用后，将其复制到Variant Array中。对此数组的行执行For循环（而不是使用ActiveCell）
创建一个大小为源数据行的结果数组，宽16列
在每次迭代中，将源数据值复制到Analysis表格中（这里可以避免某些工作簿交互）
强制使用wsAnalysis.Calculate
只需一步即可将结果复制到变体数组中。我复制范围A1:V23。（一步复制太多单元格比一次复制多个单元格要快）
将所需结果映射到Results数组，并将其映射到当前行
循环后，将结果数组复制到工作簿中的结果范围（再次一步）

其他说明：

消除所有Select，Selection，ActiveSheet，ActiveCell内容（正如其他人提到的那样）
声明所有变量
明确数组声明中的下限和上限
提供错误处理程序和CleanUp代码，以便在代码错误时启用Application属性

毕竟，性能取决于Analysis工作表的计算时间。如果你愿意分享它的细节，也可能有改进的机会

Answer 2

虽然这不会加速整个事情。您可以通过删除“选择/选择”来定时节省时间。位。

例如，对于第一部分替换：

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

使用：

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

注意：在这种情况下使用[]会替换Range（）。使用此快捷方式并不总是健康，但为了您的目的，它应该没问题。您应该始终尝试使用此格式重写您使用此格式记录的代码，它会绕过宏录制器的笨拙并将其转换为整洁的vba代码：）

Answer 3

它不是很漂亮，但速度很快。我不太擅长使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

希望这有帮助！

有没有办法加快我的宏？

3 个答案: