消除/改变循环以加速代码

时间:2017-08-04 14:19:10

标签: vba excel-vba loops do-loops coding-efficiency

我写了一些运行速度很慢的VBA代码。我的代码中有一系列不同的循环。我知道循环并不总是操作数据的最有效方式,所以我认为它们就是问题。我需要有关如何更改循环或消除它的想法,以便我可以加快代码的运行时间。

以下是我创建的最活跃的循环。它会遍历行D上的所有单元格(从D2开始),并根据第1行单元格中的条目操作它们的值。如果我可以在此循环中获得帮助,我可能就可以了使用类似的技术来改变我的代码中的其他循环。任何提示都表示赞赏。

'sub work week for date range
     Range("D2").Select
     Do Until IsEmpty(ActiveCell.Value)
         If IsEmpty(ActiveCell.Offset(-1, 0)) = False Then
             ActiveCell.Value = ActiveCell.Offset(-1, 0).Value & "-" & Right(ActiveCell.Value, 4)
         Else: ActiveCell.Value = ActiveCell.Value & "-" & Right(ActiveCell.Offset(0, -1), 4)
         End If
     ActiveCell.Offset(0, 1).Select
Loop

2 个答案:

答案 0 :(得分:1)

最快,更有效的方法,就像在评论中使用数组一样。

为了帮助您达到这一点,我已经为您提供了改进与VBA交互的第一步,并了解了如何在不选择或激活对象的情况下编写代码:

For i = 4 To Cells(2, Columns.Count).End(xlToLeft).Column
    With Cells(2, i)
        If .Offset(-1, 0).Value = vbNullString Then
            .Value = .Value & "-" & Right$(.Offset(0, -1).Value, 4)
        Else
            .Value = .Offset(-1, 0).Value & "-" & Right$(.Value, 4)
        End If
    End With
Next

基本上,您不需要.Select.Activate任何事情。直接使用对象并使用变量来指示列,而不是激活下一个单元格。

一旦您熟悉以这种方式编写代码,请查看为2D数组指定范围值,然后循环遍历数组。

答案 1 :(得分:0)

为了快速执行,我的第一个建议是,如果仍然需要很长时间,也要关闭自动计算和屏幕更新。

我同意任何涉及选择的事情都会非常慢,所以你应该使用范围对象。

最终代码:

' Declarations
Dim CurrentCell, LeftCell, PreviousCell As Range
Dim Last4Chars As String

'Initialize
Set CurrentCell = ActiveSheet.Range("D2")

'Optimizations
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

'Loop until Current Cell in Empty
Do Until IsEmpty(CurrentCell.Value)
    Set AboveCell = CurrentCell.Offset(-1, 0)        'One row above
    Set LeftCell = CurrentCell.Offset(0, -1)         'One column left

    If IsEmpty(AboveCell) = False Then
        CurrentCell.Value = AboveCell.Value & "-" & Right(CurrentCell.Value, 4)
    Else
        CurrentCell.Value = CurrentCell.Value & "-" & Right(LeftCell, 4)
    End If

    Set CurrentCell = CurrentCell.Offset(0, 1)
Loop

'Optimizations reversed for normal use
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True