用 VBA 内存数组替换工作表数组公式

Question

我的工作表需要 BG2 中的以下数组公式。

=INDEX('Client'!O$2:O$347473,
       MATCH(1, (('Client_Cost'!D$2:D$347473='Client'!BC2)*
                 ('Client_Cost'!E$2:E$347473='Client'!BE2)), 0))

这提供了一个两列匹配（Client_Cost!D:D 到 Client!BC2 和 Client_Cost!E:E 到 Client!BE2）并从 Client!O:O 返回相应的值。

大量的行使数组公式的计算量很大。我可以处理几百行（500 行约 90 秒），但我需要一直到 Client'!BG347473 的结果，我希望今年某个时候得到它们。

我尝试使用 Application Evaluate 将数组公式的结果返回到变体数组中，然后将结果数组返回到工作表 en masse 但这不是我的改进希望。寻找替代品。

Answer 1

首先，我建议使用较小的数据集开发替代方法。 5K 或 10K 行要么显示出明显的改进，要么没有；一旦您确信自己不会进入必须崩溃的长时间'未响应'状态，您始终可以扩展至原始数据集。

从该数组公式样式中删除 数组 的常用方法¹ 是“辅助”列，它将 Client_Cost 工作表中 D 列和 E 列中的两个值连接成一个单独的分隔值。例如，在 Client_Cost!Z2 中，

=CONCATENATE(Client_Cost!D2, "|", Client_Cost!E2)

填写到 Client_Cost！Z347473 应该只需要一两秒。

设置完成后，单个 INDEX/MATCH 函数对可以在类似连接的 Client!BC2 和 Client'!BE2 上提供更高效的查找。在 Client!BG2 中，

=INDEX(Client!O$2:O$347473,
   MATCH(CONCATENATE(Client!BC2, "|", Client!BE2), 
         Client_Cost'!Z$2:Z$347473, 0))

对于 350K 行，这将需要 1 小时 51 分钟。虽然尚未达到最佳状态，但与原来估计的约 17.5 小时相比，这是一个很大的改进。

优化该方法的下一个合乎逻辑的步骤是使用 VBA Scripting.Dictionary 对象。字典在其键上拥有自己的唯一索引，并且可以将连接的值填充到字典对象中，以促进对大量项目（即 行）的几乎即时查找。

Sub JR_CSE_in_Array()
    Dim olr As Long, rws As Long, JR_Count As Long, JR_Values As Variant
    Dim v As Long, vTMP As Variant, vTMPs As Variant, dVALs As Object

    Debug.Print Timer
    Set dVALs = CreateObject("Scripting.Dictionary")

    'get some dimensions to the various data ranges
    With Worksheets("Client_Cost")
        'only use as many rows as absolutely necessary
        olr = Application.Min(.Cells(Rows.Count, "D").End(xlUp).Row, _
                              .Cells(Rows.Count, "E").End(xlUp).Row)
        'store D & E
        vTMPs = .Range(.Cells(2, 4), .Cells(olr, 5)).Value2

    End With
    With Worksheets("Client")
        rws = Application.Min(.Cells(Rows.Count, "BC").End(xlUp).Row, _
                              .Cells(Rows.Count, "BE").End(xlUp).Row, _
                              UBound(vTMPs, 1))
        'override the above statement for sampling
        'rws = 5000

        'building the Dictionary object takes a fair bit of time but it is worth it
        vTMP = .Range(.Cells(2, 15), .Cells(olr, 15)).Value2
        For v = LBound(vTMPs, 1) To UBound(vTMPs, 1)
            If Not dVALs.Exists(Join(Array(vTMPs(v, 1), vTMPs(v, 2)), ChrW(8203))) Then _
                dVALs.Add Key:=Join(Array(vTMPs(v, 1), vTMPs(v, 2)), ChrW(8203)), Item:=vTMP(v, 1)
        Next v

        'store BC and BE
        vTMPs = .Range(.Cells(2, 55), .Cells(olr, 57)).Value2
    End With

    ReDim JR_Values(1 To rws, 1 To 1)   'force a two-dimension, one-based index on the array
    'Debug.Print LBound(JR_Values) & ":" & UBound(JR_Values)

    For JR_Count = LBound(JR_Values, 1) To UBound(JR_Values, 1) Step 1
        If dVALs.Exists(Join(Array(vTMPs(JR_Count, 1), vTMPs(JR_Count, 3)), ChrW(8203))) Then
            JR_Values(JR_Count, 1) = dVALs.Item(Join(Array(vTMPs(JR_Count, 1), vTMPs(JR_Count, 3)), ChrW(8203)))
        End If
    Next JR_Count

    With Worksheets("Client")
        .Range("BG2").Resize(UBound(JR_Values), 1) = JR_Values
    End With

    'Debug.Print dVALs.Count
    dVALs.RemoveAll: Set dVALs = Nothing
    Debug.Print Timer
End Sub

该例程运行所用的时间（没有辅助列）为 45.72 秒。分解它，仅仅构建字典就花了整整 13.4 秒，其余的大部分被实际查找占用，这里和那里半秒归因于从工作表的值中大量播种变体数组。

         

因此，Scripting.Dictionary 显然是赢家。不幸的是，当值发生变化时，它不会自动计算各个列中的更新，但在这个开发阶段，工作表应该设置为手动计算。将一个基于公式的解决方案从单个重新输入的值设置为重新计算事件似乎是一种低效的时间消耗。

总而言之，这很有意义。原始数组公式类似于在两个字段上使用 INNER JOIN 的 SQL SELECT 语句，如果我的 SELECT 语句运行效率低下，我首先要改进它的是查看表的索引。

在相关说明中，任何包含这么多数据的工作簿都应保存为 Excel 二进制工作簿，无论它是否启用了宏。二进制工作簿 (.XLSB) 的文件大小通常是等效 .XLSX 或 .XLSM 大小的 ¹⁄₃。除了更快的初始加载时间之外，许多批量操作应该会更快。

任何想要测试自己的优化的人都可以暂时找到我的示例 .XLSB 工作簿here。不要盲目地运行程序而不先看到你要进入的内容。

---

¹ _{数组公式需要使用 Ctrl+Shift+Enter↵ 完成。一旦正确输入第一个单元格，它们就可以像任何其他公式一样被填充或向下或向右复制。尝试将全列引用减少到更接近代表实际数据范围的范围。数组公式以对数方式消耗计算周期，因此最好将引用范围缩小到最小值。更多信息请参见Guidelines and examples of array formulas。}