Vba 有没有办法加快我的宏速度？

我有一个宏，它将获取列表中的每个值，将其放在不同的工作表中（它执行自己的计算），并返回某些值（如摘要工作表）。我创建了一个循环宏来执行这个操作，但是由于列表上有大约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

---

虽然这不会加快整个过程。您可以通过去掉“选择/选择”位来定义节省时间

例如，第一节替换为：

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

与：

注意：在本例中使用[]将替换Range（）。使用此快捷方式并不总是健康的，但出于您的目的，它应该是好的。

---

您应该总是尝试重写使用这种格式录制的代码，然后再做其他事情。它绕过了宏录制器的笨拙，将其转换为整洁的vba代码：）

它不是很漂亮，但速度很快。我不太擅长提高阵列的速度，但这可能是另一种解决方案

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

---

希望这有帮助

快速VBA循环的关键是尽量减少与循环内工作簿的交互

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

关键步骤是：

您可以使用手动计算。（见下文）

创建

工作表

和

范围

对象变量，以引用工作表和范围

创建变量数组以保存源数据、结果数据和分析结果

对源数据进行引用后，将其复制到变量数组中。对该数组的行执行

For

循环（而不是使用

ActiveCell

）

创建一个结果数组，大小与源数据行相当，宽16列

在每次迭代中，将源数据值复制到分析表上（在这里您无法避免一些工作簿交互）

使用

wsAnalysis.Calculate重新计算分析表

一步将结果复制到变量数组。我将复制范围

A1:V23

。（一步复制过多单元格比一次复制一个单元格快）

将所需结果映射到结果数组中的当前行中

循环完成后，将结果数组复制到工作簿中的结果区域（一步完成）

其他说明：

消除所有

Select

，

Selection

，

ActiveSheet

，

ActiveCell

内容（如其他人所述）

声明所有变量

在数组声明中明确上下限

提供错误处理程序和清理代码，以便在代码出错时打开

应用程序

属性

---

在所有这些之后，性能将取决于

分析

工作表的计算时间。这里可能也有改进的机会，如果您愿意首先分享其详细信息，请检查两个更改：

1

删除所有

Select

，

Selection

语句

2

在移动数据或公式结果（而非实际公式）的地方，在一个步骤中将所有数据读取到VBA数组中：例如

V=Range（“B5:V23”）

，然后将特定单元格移动到新数组中

array1（0）=V（1,5）

将F5中的内容放入array1（0）；等等然后将数组读回工作表

myrange=array1

根据我的经验，在VBA中使用数组与来回查看工作表相比，速度可以提高十倍。感谢您提供的此技巧！我没有想到这样做，但它肯定有助于提高我的宏的速度！谢谢你的帮助！这些都是很好的建议，我尽可能多地去实现。谢谢你这么做！我试着用每个人的注释尽可能多地实现，但是当你输入代码时，它能以指数级的速度看到代码。谢谢你的帮助！我想我在学习“在路上”的时候养成了使用选择的坏习惯，并且一直没有摆脱它。接下来，我将尝试实现更多此类代码。

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