使用用户定义函数计算 VBA 数组中的唯一值

使用用户定义函数计算 VBA 数组中的唯一值

我有一个 VBA 函数,它根据用户提供的条件遍历几个用户提供的范围,并将项目添加到数组中。对于其设计的用例,它几乎肯定会添加重复项。最后,我只对我构建的数组中唯一项目的数量感兴趣。

我正在尝试调用这个函数:

Function GetUniqueCount(aFirstArray As Variant)

Dim arr As New Collection, a
Dim i As Long

On Error Resume Next

For Each a In aFirstArray
    arr.Add a, Str(a)
Next

GetUniqueCount = arr.Count

End Function

就像这样:

Function Stuff(parameters)

Dim myArray() as Variant

...do things to populate myArray, finally

Stuff = GetUniqueCount(myArray)

函数 GetUniqueCount 是对已接受答案的一个非常轻微的修改这里关于类似的问题。

当我这样做时,Stuff 总是会返回 1,即使它显然不应该返回 1。到目前为止,我测试了 Stuff,它准确地产生了预期元素的数量,只是当我尝试计算那些唯一元素的数量时,我做错了。任何帮助都将不胜感激,因为我仍在掌握 VBA 数组。

答案1

我对UDF().............研究差异:

Function GetUniqueCount(aFirstArray()) As Long
    Dim arr As Collection
    Set arr = New Collection

    On Error Resume Next
        For Each a In aFirstArray
            arr.Add a, CStr(a)
        Next
    On Error GoTo 0
    GetUniqueCount = arr.Count
End Function

Sub MAIN()
    Dim inpt()
    inpt = Array("alpha", "alpha", "beta", "beta", "gamma")
    MsgBox GetUniqueCount(inpt)
End Sub

在此处输入图片描述

答案2

'要检查特定列中的范围,这里是第 8 列(H 列),从第 11 行开始,请尝试以下代码。(更改列和起始行以满足您的需要)

Sub Find_unique()
Dim Y As Integer, Z As Integer, cont As Integer, _
Vlue As String, lop1 As Integer, lop2 As Integer, duplct As Integer
        lastrow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).row
        lop1 = 11
        lop2 = 12   'Add 1 to the lop1 value
        If Len(Trim(ActiveSheet.Cells(11, 8))) > 0 Then
        GoTo Act
        ElseIf (Trim(ActiveSheet.Cells(11, 8))) = 0 Then
        GoTo Finish
        End If
Act:
       Y = lop1
        Vlue = ActiveSheet.Cells(Y, 8)
        cont = cont + 1
        For Z = lop2 To lastrow
        If ActiveSheet.Cells(Z, 8) = Vlue Then
        duplct = duplct + 1
        End If
        Next Z
        lop1 = lop1 + 1
        If Y = lastrow Then
        GoTo Don
        Else
        lop2 = lop2 + 1
        GoTo Act
        End If
Don:
        MsgBox "The total record is: " & cont _
        & vbCrLf & duplct & " of them are duplicated" _
        & vbCrLf & "unique counts: " & (cont - duplct)
End Sub

相关内容