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

我的工作表需要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秒），但我需要一直到客户端的结果！BG347473，我想在今年的某个时候买

---

我曾尝试使用将数组公式中的结果返回到变量数组中，然后将结果数组整体返回到工作表中，但这并不是我所希望的改进。寻找替代方法。

首先，我建议开发具有较小数据集的替代方法。5K或10K行将显示是否有明显的改善；一旦您确信不会进入长时间的“无响应”状态，您就可以随时扩展到原始数据集

从该样式的数组公式“”中删除该数组的常用方法是“helper”列，该列将客户成本工作表中D列和E列中的两个值连接成一个单独的分隔值。例如，在客户成本中！z2as

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

填写到客户成本！Z347473只需一两秒钟

一旦设置好，单个/函数对就可以在类似连接的客户机上提供更高效的查找！BC2和客户端'！BE2。在客户端！BG2 as

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

这将需要1小时，350K排51分钟。虽然还不是最理想的，但与最初估计的17.5小时相比，这是一个很大的改进

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

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

所以脚本字典显然是这里的赢家。不幸的是，当值更改时，它不会自动计算各个列中的更新，但是在开发的这个阶段，工作表应该设置为手动计算。从一个重新键入的值将一个基于公式的解决方案设置为重新计算事件似乎是一种低效的时间开销

总而言之，这是完全有道理的。最初的数组公式类似于在两个字段上具有内部联接的SQL SELECT语句，如果SELECT语句运行效率低下，我要做的第一件事就是查看表的索引

另一方面，任何包含如此多数据的工作簿都应保存为Excel二进制工作簿，无论它是否启用了宏。二进制工作簿（.XLSB）的文件大小通常为1/4₃ 等效的.XLSX或.XLSM的大小。除了更快的初始加载时间外，许多批量操作应该更快

任何希望测试自己优化的人都可以暂时找到我的sample.XLSB工作簿。不要盲目地运行程序，而不先了解自己的情况

---

---

imk_数组公式需要使用Ctrl+Shift+Enter完成↵. 正确输入第一个单元格后，可以像任何其他公式一样填充或向下或向右复制它们。尝试将整列引用减少到更接近实际数据范围的范围。数组公式以对数方式消耗计算周期，因此最好将参考范围缩小到最小值。有关更多信息，请参阅。

这一切似乎都很熟悉。。。您错过了一个明显的选项—对键列进行排序，以便可以利用公式中的二进制搜索。@Rory-True“dat。其目的实际上是为了进入dictionary选项，我跳过了几个步骤来实现它。我认为在填充dictionary时跳过

Exists

测试，只需使用：

dVALs（Join（Array（vTMPs（v，1），vTMPs（v，2）），ChrW（8203））=vTMP（v，1）就可以加快速度

相反。奇怪的是，我对它进行了测试，结果比对.Exists的测试长了整整一个半秒。最重要的是，在重复条目的情况下，最后一个条目将作为.Item返回，后者将被后一个值覆盖，这与原始数组公式.Odd相矛盾。我刚刚测试了一下，它缩短了1.5秒！不过我接受你的最后一点。

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