Fatal编程技术网
  • vba/
  • Vba 如何加快代码执行速度？

Vba 如何加快代码执行速度？

vba excel

Vba 如何加快代码执行速度？,vba,excel,Vba,Excel,我有一个很好的习惯。唯一的问题是执行时间太长。你能就如何加快速度提出建议吗？我认为一种方法是直接将值赋给范围，而不是通过选择工作表然后使用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 = "***" D

我有一个很好的习惯。唯一的问题是执行时间太长。你能就如何加快速度提出建议吗？我认为一种方法是直接将值赋给范围，而不是通过选择工作表然后使用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
以下是对上述评论的总结：

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
    （因为未在sub中使用）
  • 禁用屏幕更新、计算和事件
  • 删除所有
    。选择
    （最后一个除外）
  • 总结几个步骤
  • 使用
    .Value2
    而不是
    .Value
    • 以下是对上述评论的总结：

    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
    （因为未在sub中使用）
  • 禁用屏幕更新、计算和事件
  • 删除所有
    。选择
    （最后一个除外）
  • 总结几个步骤
  • 使用
    .Value2
    而不是
    .Value
    • 加速宏的一个好方法是使用
    Application.screenUpdate=False
    和
    Application.Calculation=xlManual
    和
    Application.EnableEvents=False
    。在退出sub之前，请确保将它们返回到
    True
    和
    xlAutomatic
    和
    True
    。xlManual和EnableEvents是做什么的？这确实不是合适的平台。看见您还想停止使用
    。选择
    请参阅。另一个可以使用的方法是使用数组，而不是经常引用excel工作表。对不起，通常我会问更多有针对性的问题。该网站新增。请参阅本页右侧的“相关”链接。加速宏的一个好方法是使用
    Application.ScreenUpdate=False
    和
    Application.Calculation=xlManual
    和
    Application.EnableEvents=False
    。在退出sub之前，请确保将它们返回到
    True
    和
    xlAutomatic
    和
    True
    。xlManual和EnableEvents是做什么的？这确实不是合适的平台。看见您还想停止使用
    。选择
    请参阅。另一个可以使用的方法是使用数组，而不是经常引用excel工作表。对不起，通常我会问更多有针对性的问题。新网站。请参阅本页右侧的“相关”链接。