我如何加快执行代码？

我有一个很好的例程。 唯一的问题是执行时间太长。 你能提出如何加速的build议吗？ 我认为一种方法是我直接将属性值范围，而不是select工作表，然后使用activesheet对象。

Sub calculate() Dim rng1 As Range Dim lastCell As Range Dim starFill As Range 'Dim LastCellRowNumber As Long Dim strFind As String Dim rng2 As Range strFind = "***" Dim clearFormat As Range Dim demand As Range Dim demandFill As Range Dim supply As Range Dim supplyFill As Range Dim delta As Range Dim deltaFill As Range Dim i As Integer Dim j As Integer Dim rng3 As Range Dim rng4 As Range Dim lasteCell2 As Range Dim rng5 As Range Dim rng6 As Range Dim mon As Range Dim k As Integer 'save month values from resource plan for use in dashboard Worksheets("Resource Plan").Columns("D:D").EntireColumn.Hidden = False For j = 1 To 6 Worksheets("Resource Plan").Select Set mon = ActiveSheet.Cells(2, (j + 9)) For k = 1 To 29 Select Case k Case 5, 11, 17, 23, 29 Worksheets("Dashboard").Select Worksheets("Dashboard").Cells(k, (j + 3)).Value = mon Case Else End Select Next k Next j 'calculate demand Worksheets("Resource Plan").Select Set rng4 = ActiveSheet.Columns("D").Find(strFind, , xlValues, xlWhole) rng4.Select Set lastCell2 = ActiveSheet.Cells(ActiveSheet.Rows.Count, (4)).End(xlUp) Set rng5 = Range(rng4, lastCell2) Set rng5 = rng5.Offset(0, 0).Resize(rng5.Rows.Count - 1) For i = 0 To 29 Worksheets("Resource Plan").Select Set rng1 = ActiveSheet.Columns("J").Find(strFind, , xlValues, xlWhole) Set lastCell = ActiveSheet.Cells(ActiveSheet.Rows.Count, (10)).End(xlUp) Set rng2 = Range(rng1, lastCell) Set rng2 = rng2.Offset(4, i).Resize(rng2.Rows.Count - 5, rng2.Columns.Count) rng2.Select Selection.Copy Worksheets("Sheet1").Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False Set rng3 = Sheets("Sheet1").Cells(1, 3) rng3.Select Selection.Copy Worksheets("Results").Select Cells(18, (i + 7)).Select Selection.PasteSpecial Paste:=xlValues Next i Worksheets("Resource Plan").Select Columns("D:D").EntireColumn.Hidden = True Cells(1, 1).Select 'Worksheets("Dashboard").Select End Sub 

Answer 1

只是要总结一下上面的一些评论：

 Option Explicit Sub calculate() Dim rng1 As Range Dim lastCell As Range Dim strFind As String Dim rng2 As Range strFind = "***" Dim i As Integer Dim j As Integer Dim rng3 As Range Dim rng4 As Range Dim lastCell2 As Range Dim rng5 As Range Dim k As Integer With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False End With With Worksheets("Resource Plan") 'save month values from resource plan for use in dashboard .Columns("D:D").EntireColumn.Hidden = False For j = 1 To 6 For k = 1 To 29 Select Case k Case 5, 11, 17, 23, 29 Worksheets("Dashboard").Cells(k, (j + 3)).Value2 = .Cells(2, (j + 9)).Value2 Case Else End Select Next k Next j 'calculate demand Set rng4 = .Columns("D").Find(strFind, , xlValues, xlWhole) Set lastCell2 = .Cells(.Rows.Count, (4)).End(xlUp) Set rng5 = .Range(rng4, lastCell2) Set rng5 = rng5.Offset(0, 0).Resize(rng5.Rows.Count - 1) For i = 0 To 29 Set rng1 = .Columns("J").Find(strFind, , xlValues, xlWhole) Set lastCell = .Cells(.Rows.Count, (10)).End(xlUp) Set rng2 = Range(rng1, lastCell) Set rng2 = rng2.Offset(4, i).Resize(rng2.Rows.Count - 5, rng2.Columns.Count) rng2.Copy Destination:=Worksheets("Sheet1").Range("A1") Set rng3 = Sheets("Sheet1").Cells(1, 3) Worksheets("Results").Cells(18, (i + 7)).Value2 = rng3.Value2 Next i .Columns("D:D").EntireColumn.Hidden = True .Activate .Cells(1, 1).Select End With 'Worksheets("Dashboard").Select With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableEvents = True End With End Sub 

1. 不必要的Dim （因为不在子中使用）已被删除。
2. 禁用ScreenUpdating，Calcultion和事件。
3. 删除所有。select（除了最后一个）。
4. 总结几个步骤。
5. 使用.Value2而不是.Value