独特的计数（Excel VBA vs公式）更快的方法

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

试图解决scheme1：公式

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

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

尝试解决scheme2：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 

注意：这是更快，但我仍然在寻找更快的方法

Answer 1

尝试这个

 '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 

Answer 2

我会使用一个数组以及字典：

 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