Question

我正在尝试使用字典将与唯一ID组合相关的总余额移动到另一张工作表。该循环可能必须运行数万行，甚至在900行时，该过程也要花费大约30秒。

我的代码可以处理（多个）字典和循环，但是速度很慢。我想知道是否有一种优化循环的方法（可能通过使用数组？尽管我对它们没有太多经验）。

我试图为I = lbound到ubound设置一个数组循环，但是我离它的工作还差得很远（代码是一团糟）。下面是一段代码，也是我正在尝试优化的循环之一。稍后还有其他4个循环，但是现在我只想优化一个循环。

'declare start/end rows
Dim StartRowPeriod As Long
    StartRowPeriod = 7
Dim LastRowPeriod As Long
    LastRowPeriod = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

'more dims for total bal
Dim HardCopyID As String
Dim Old_Balance As Double
Dim New_Balance As Double
Dim Updated_Balance As Double

Application.ScreenUpdating = False

'RUNNING THE DICTIONARY (ADDING THE TOTAL VALUES TO THE UNIQUE IDS)
For I = StartRowPeriod To LastRowPeriod
    HardCopyID = Cells(I, 11).Value
        If HardCopyID = "" Then
            Exit For
        ElseIf HardCopy_Dictionary.Exists(HardCopyID) Then
            Old_Balance = HardCopy_Dictionary(HardCopyID)
            New_Balance = Cells(I, 10).Value
            Updated_Balance = Old_Balance + New_Balance
            HardCopy_Dictionary(HardCopyID) = Updated_Balance
        Else
            HardCopy_Dictionary(HardCopyID) = Cells(I, 10).Value
        End If
Next I

Answer 1

您是正确的，切换到Variant Array方法将大大加快此过程。

您进行编码，重构为使用数组，并进行其他一些清理：

Sub Demo()
    ' declare all variables
    Dim i As Long
    Dim HardCopy_Dictionary As Dictionary ' early bound: set a reference to Microsoft Scripting Runtime
    'Dim HardCopy_Dictionary As Object ' late bound
    Dim ws As Worksheet
    Dim Dat As Variant

    'declare start/end rows
    Dim StartRowPeriod As Long
    Dim LastRowPeriod As Long

    'more dims for total bal
    Dim HardCopyID As String
    Dim Old_Balance As Double
    Dim New_Balance As Double
    Dim Updated_Balance As Double

    ' Application.ScreenUpdating = False 'not needed as there is no sheet interaction

    Set HardCopy_Dictionary = New Dictionary ' Early bound
    'Set HardCopy_Dictionary = CreateObject("Scripting.Dictionary")  ' Late bound

    Set ws = ActiveSheet

    StartRowPeriod = 7
    With ws
        LastRowPeriod = .Cells(.Rows.Count, 1).End(xlUp).Row

        ' Copy data to array
        Dat = .Range(.Cells(1, 1), .Cells(LastRowPeriod, 11)).Value
        'RUNNING THE DICTIONARY (ADDING THE TOTAL VALUES TO THE UNIQUE IDS)
        For i = StartRowPeriod To LastRowPeriod
            HardCopyID = Dat(i, 11) '.Cells(i, 11).Value
            If HardCopyID = vbNullString Then
                Exit For 'are you sure about this? Surley it should run to the end of the data?
            ElseIf HardCopy_Dictionary.Exists(HardCopyID) Then
                Old_Balance = HardCopy_Dictionary(HardCopyID)
                New_Balance = Dat(i, 10) '.Cells(i, 10).Value
                Updated_Balance = Old_Balance + New_Balance
                HardCopy_Dictionary(HardCopyID) = Updated_Balance
            Else
                HardCopy_Dictionary.Add HardCopyID, Dat(i, 10) '.Cells(i, 10).Value
            End If
        Next i
    End With
End Sub

这几乎立即在100,000行的某些模型数据上运行。

Answer 2

食谱

使用完全合格的 范围参考，否则默认情况下是指活动表。
通过VBA遍历范围总是很耗时，因此请使用数组。建议参考工作表的 codename （请参见VB编辑器），例如。 UIViewController和将数据范围分配给基于变体2维1的 数组，如下所示：
```
Sheet1
```
仅引用Dim myArray ' As Variant MyArray = Sheet1.Range("A1:K" & Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row)而不是MyArray或Cells(...)或Sheet1.cells(...)来撰写
```
ThisWorkbook.Worksheets("Sheet1").Cells(...)
```
（我假设您没有忘记在代码模块的声明头中使用HardCopyID = myArray(I, 11).Value ' instead of HardCopyID = Cells(I, 11).Value New_Balance = myArray(I, 10).Value ' instead of New_Balance = Cells(I, 10).Value HardCopy_Dictionary(HardCopyID) = myArray(I, 10).Value ' instead of HardCopy_Dictionary(HardCopyID) = Cells(I, 10).Value 在此模块中强制 all 变量的显式声明，例如Option Explicit）

祝你好运：-）

有没有办法将此循环更改为数组/范围引用？

2 个答案: