Excel VBA - Formula Counting Unique Value error

Question

I am trying to calculate the count of Unique values based on a condition.

For example,

For a value in column B, I am trying to count the Unique values in Column C through VBA.

I know how to do it using Excel formula -

 =SUMPRODUCT((B2:B12<>"")*(A2:A12=32)/COUNTIF(B2:B12,B2:B12))

that value for 32 is dynamic - Programmatically I am calling them inside my vba code as Name

This is my code :

Application.WorksheetFunction.SumProduct((rng <> "") * (rng2 = Name) / CountIfs(rng, rng))

This is the sample data with the requirement

Alternatively, I Concatenated both the columns for keeping it simple and hoping to identify the Unique values which starts with name* method.

I don't know where I am going wrong. Kindly share your thoughts.

Answer 1

您可以尝试这样的事情......

Function GetUniqueCount(Rng1 As Range, Lookup As String) As Long
Dim x, dict
Dim i As Long, cnt As Long
Set dict = CreateObject("Scripting.Dictionary")
x = Rng1.Value
For i = 1 To UBound(x, 1)
    If x(i, 1) = Lookup Then
        dict.Item(x(i, 1) & x(i, 2)) = ""
    End If
Next i
GetUniqueCount = dict.Count
End Function

然后你可以像下面那样使用它......

=GetUniqueCount($A$2:$B$10,C2)

其中A2：B10是数据范围，C2是名称标准。

Answer 2

我将这些值放入一个数组中，创建一个临时的第二个数组，只有当它们不存在时才向该数组添加值，然后替换原始数组。然后，总结唯一值只是一件简单的事情：

Sub Unique

dim arr(10) as variant, x as variant
dim arr2() as variant

for x = 1 to 10 ' or whatever
   arr(x) = cells(x, 1) ' or whatever
next x

arr2 = UniqueValuesArray(arr)

' now write some code to count the unique values, you get the idea

End Sub

Function UniqueValuesArray(arr As Variant) As Variant()

Dim currentRow, arrpos As Long
Dim uniqueArray() As Variant
Dim x As Long

arrpos = 0
ReDim uniqueArray(arrpos)

For x = 0 To UBound(arr)
    If UBound(Filter(uniqueArray, arr(x))) = -1 Then
        ReDim Preserve uniqueArray(arrpos)
        uniqueArray(arrpos) = arr(x)
        arrpos = arrpos + 1
    End If
Next x

UniqueValuesArray = uniqueArray

End Function