从VBA范围中获取唯一字符串的数量

Question

下面是提供唯一单元格的函数，但我想在给定范围内的所有单元格中找到唯一的字符串。

代码：

Public Function CountUnique(rng As Range) As Integer
Dim dict As Dictionary
Dim cell As Range
Set dict = New Dictionary
For Each cell In rng.Cells
     If Not dict.Exists(cell.Value) Then
        dict.Add cell.Value, 0
    End If
Next
CountUnique = dict.Count
End Function

Answer 1

尝试此代码

Sub Test_CountUnique_UDF()
MsgBox CountUnique(Range("B1:B4"))
End Sub

Public Function CountUnique(rng As Range) As Integer
Dim e, dict As Dictionary, cell As Range

Set dict = New Dictionary

For Each cell In rng.Cells
    For Each e In Split(cell, ", ")
        If Not dict.Exists(e) Then dict.Add e, 0
    Next e
Next cell

CountUnique = dict.Count
End Function

另一种变化（后期绑定）

Sub Test_CountUniq_UDF()
MsgBox CountUniq(Range("B1:B4"), ",")
End Sub

Function CountUniq(rng As Range, delim As String) As Long
Dim e       As Variant
Dim s       As Variant

With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For Each e In rng.Value
        If Trim$(e) <> "" Then
            For Each s In Split(e, delim)
                If Trim$(s) <> "" Then .item(Trim$(s)) = Empty
            Next s
        End If
    Next e
    CountUniq = .Count
End With
End Function