唯一计数（Excel VBA 与公式）更快的方法

Posted 2023-04-13

【中文标题】唯一计数（Excel VBA 与公式）更快的方法

【英文标题】：Unique Count (Excel VBA vs Formulas) Faster Approach

【发布时间】：2015-11-04 12:01:48

【问题描述】：

64 位 Win7 上的 32 位 Excel 365 工作表 300600 行 x 105 列 目标：计算每列的唯一条目数

尝试的解决方案 1：公式

=SUM(1/COUNTIF(A8:A300600,A8:A300600))

问题：长时间运行，冻结 Excel，必须停止计算

尝试的解决方案 2：VBA UDF

Function UniqueCount(Selection As Range) As Integer
Dim UniqueArray()
ReDim UniqueArray(0 To Selection.Count)
Dim Rng As Range
Dim CUniqueCount As Integer
CUniqueCount = 0
For Each Rng In Selection
    For i = 0 To Selection.Count
        If UniqueArray(i) = Rng.Value Then Exit For
        If UniqueArray(i) = "" Then
            UniqueArray(i) = Rng.Value
            CUniqueCount = CUniqueCount + 1
            Exit For
        End If
    Next i
Next
UniqueCount = CUniqueCount
End Function

注意：这要快得多，但我仍在寻找更快的方法

【问题讨论】：

我没有，我这样做的原因是将数据集分解为较小的表以上传到我的访问数据库中——数据集太大而无法在内部破坏访问的内存限制。我想我也可以通过数据透视表来达到这些限制。它们与我在所有 105 列中应用公式化方法时遇到的限制相同。

【参考方案1】：

我会使用数组和字典：

Public Function CountUnique(rngInput As Range) As Double
    Dim rngCell               As Range
    Dim dData                 As Object
    Dim vData
    Dim x                     As Long
    Dim y                     As Long

    Set dData = CreateObject("Scripting.Dictionary")

    vData = rngInput.Value2
    For x = LBound(vData, 1) To UBound(vData, 1)
        For y = LBound(vData, 2) To UBound(vData, 2)
            If LenB(vData(x, y)) <> 0 Then dData(CStr(vData(x, y))) = Empty
        Next y
    Next x
    CountUnique = dData.Count
End Function

【参考方案2】：

试试这个

'Set a reference to MS Scripting runtime ('Microsoft Scripting Runtime')
Function UniqueCount(SelRange As Range)
    Dim Rng As Range
    Dim dict As New Scripting.Dictionary
    Set dict = CreateObject("Scripting.Dictionary")
    For Each Rng In SelRange
        If Not dict.Exists(Rng.Value) Then
            dict.Add Rng.Value, 0
        End If
    Next Rng
    UniqueCount = dict.Count
    Set dict = Nothing
End Function

【讨论】：

有趣的是，事后看来，计算的持续时间更多地取决于找到的唯一匹配项的数量，因为嵌套迭代复合了选择迭代，因此当数量较少时，我们的 UDF 执行非常相似唯一值，但是当有大量唯一值时，您的表现要好得多 -- 谢谢！