时间戳

首页 > 解决方案 > For Loop VBA 通过放入数组来加速

vba - For Loop VBA 通过放入数组来加速

问题描述

我正在尝试遍历大约 2000 行数据，并在每个循环中执行一个 for 循环和几个 if 语句。它有效，但现在它非常缓慢。我从我的研究中了解到，如果我可以将数据放入一个数组并在那里对其进行操作，然后将数据放回单元格中会更快，但我可以在编码方面使用一些帮助来做到这一点。这是我的代码。

Sub EliminateVariance()

    Dim Old As Long
    Dim Older As Long
    Dim Oldest As Long
    Dim Current As Long
    Dim VarianceOld As Long
    Dim VarianceNew As Long
    Dim VarianceNew1 As Long
    Dim VarianceNew2 As Long
    Dim Month1 As Variant
    Dim SheetName As Variant
    Dim LastRow As Long
    Dim i As Long

    Month1 = InputBox("What is this month?")

    SheetName = Month1 & " SummaryByCust"

    Worksheets(SheetName).Activate

    LastRow = Cells(Rows.count, "B").End(xlUp).row

    For i = 3 To LastRow
        VarianceOld = Range("V" & i)
        Oldest = Range("I" & i)
        Older = Range("H" & i)
        Old = Range("G" & i)
        Current = Range("F" & i)

        If VarianceOld > Oldest Then
            VarianceNew = VarianceOld - Oldest
            Range("I" & i) = 0
            If VarianceNew > Older Then
                VarianceNew1 = VarianceNew - Older
                Range("H" & i) = 0
                If VarianceNew1 > Old Then
                    VarianceNew2 = VarianceNew1 - Old
                    Range("G" & i) = 0
                    If VarianceNew2 > Current Then
                        MsgBox ("Error: Deferred is greater than what it should be. Verify your numbers")
                    Else
                        Range("F" & i) = Current - VarianceNew2
                    End If
                Else
                    Range("G" & i) = Old - VarianceNew1
                End If
            Else
                Range("H" & i) = Older - VarianceNew
            End If
        Else
            Range("I" & i) = Oldest - VarianceOld
        End If
    Next i

End Sub

标签： vbaexcelfor-loopoptimization

解决方案

下面是一个关于如何使用数组的示例：

Sub arrayEx()

'Set the range
Dim rng As Range
Set rng = Worksheets("Sheet1").Range("A1:B20000")

'Bulk load the values from the range into an array
'Even if a single column this will create a 2D array
Dim rngArr As Variant
rngArr = rng.Value

'Loop the "Rows" of the array
Dim i As Long
For i = LBound(rngArr, 1) To UBound(rngArr, 1)
    'Do something with that array
    'when loaded from a range it is similar nomenclature to Cells: array(row,column)
    If rngArr(i, 1) = "A" Then
        rngArr(i, 2) = "B"
    End If
Next i

'overwrite the values in range with the new values from the array.
rng.Value = rngArr

End Sub

尝试适应您的需求。

推荐阅读