Question

我有一个非常好的例程。唯一的问题是执行时间太长。你能就如何加快它提出建议吗？我认为一种方法是让我直接将值属性化为范围，而不是选择工作表然后使用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

已删除不必要的Dim（因为未在子网站中使用）。
禁用ScreenUpdating，Calcultion和Events。
删除所有.Select（最后一个除外）。
总结了几个步骤。
使用.Value2代替.Value

如何加快代码执行速度？

1 个答案: