Eşsiz virgülle ayrılmış değerleri nasıl sayabilirim - Erken Sınır ve Geç Sınır

Tek bir hücrede bir değer dizisinden gelen benzersiz değerleri (virgülle ayrılmış olarak) görüntülemeye çalışıyorum.

Bu çözüme rastladım: Benzersiz bir virgülle ayrılmış değerleri Excel 2010'da nasıl sayabilirim

Function ListCount(list As String, delimiter As String) As Long
Dim arr As Variant
arr = Split(list, delimiter)
ListCount = UBound(arr) - LBound(arr) + 1
End Function

Function RemoveDuplicates(list As String, delimiter As String) As String
Dim arrSplit As Variant, i As Long, tmpDict As New Dictionary, tmpOutput As String
arrSplit = Split(list, delimiter)
For i = LBound(arrSplit) To UBound(arrSplit)
    If Not tmpDict.Exists(arrSplit(i)) Then
        tmpDict.Add arrSplit(i), arrSplit(i)
        tmpOutput = tmpOutput & arrSplit(i) & delimiter
    End If
Next i
If tmpOutput <> "" Then tmpOutput = Left(tmpOutput, Len(tmpOutput) - Len(delimiter))
RemoveDuplicates = tmpOutput
'housekeeping
Set tmpDict = New Dictionary
End Function

Ancak bu, Microsoft Scripting Çalışma Zamanı referansının eklenmesini gerektirir.

Referans gerektirmeyen bir sürüm yayınladınız. Sadece formül yerleşiminin / yapısının ne olduğunu merak ediyorum. Örnek: = UNIQUECOUNTIF ()? Herhangi bir yardım takdir edilecektir.

Function UNIQUECOUNTIF(ByRef SR As Range, _
                        ByRef RR As Range, _
                        Optional ByVal Crit As Variant, _
                        Optional NCOUNT As Boolean = False, _
                        Optional POSTCODE As Boolean = False) As Long
Dim K1, K2, i As Long, c As Long, x, n As Long
K1 = SR: K2 = RR
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(K1, 1)
        If Not IsMissing(Crit) Then
            If LCase$(K1(i, 1)) = LCase$(Crit) Then
                If POSTCODE Then
                    x = Split(Replace(LCase$(K2(i, 1)), ",", " "), " ")
                Else
                    x = Split(LCase$(K2(i, 1)), ",")
                End If
                For c = 0 To UBound(x)
                    If POSTCODE Then
                        If IsNumeric(x(c)) Then
                            If Not .exists(x(c)) Then
                                .Add x(c), 1
                            ElseIf NCOUNT Then
                                .Item(x(c)) = .Item(x(c)) + 1
                            End If
                        End If
                    Else
                        If Not .exists(x(c)) Then
                            .Add x(c), 1
                        ElseIf NCOUNT Then
                            .Item(x(c)) = .Item(x(c)) + 1
                        End If
                    End If
                Next
            End If
        Else
            If POSTCODE Then
                x = Split(Replace(LCase$(K2(i, 1)), ",", " "), " ")
            Else
                x = Split(LCase$(K2(i, 1)), ",")
            End If
            For c = 0 To UBound(x)
                If POSTCODE Then
                    If IsNumeric(x(c)) Then
                        If Not .exists(x(c)) Then
                            .Add x(c), 1
                        ElseIf NCOUNT Then
                            .Item(x(c)) = .Item(x(c)) + 1
                        End If
                    End If
                Else
                    If Not .exists(x(c)) Then
                        .Add x(c), 1
                    ElseIf NCOUNT Then
                        .Item(x(c)) = .Item(x(c)) + 1
                    End If
                End If
            Next
        End If
    Next
    If .Count > 0 Then UNIQUECOUNTIF = Application.Sum(.items)
End With
End Function

Ne hakkında saymak için :

Public Function ListCount(Sin As String) As Long
   Dim c As Collection, ary, a
   Set c = New Collection
   ary = Split(Sin, ",")
   ListCount = 0

   On Error Resume Next
      For Each a In ary
         c.Add a, CStr(a)
         If Err.Number = 0 Then ListCount = ListCount + 1
         Err.Number = 0
      Next a
   On Error GoTo 0
End Function

İçin listeleme :

Public Function ListList(Sin As String) As String
   Dim c As Collection, ary, a
   Set c = New Collection
   ary = Split(Sin, ",")
   ListList = ""

   On Error Resume Next
      For Each a In ary
         c.Add a, CStr(a)
         If Err.Number = 0 Then ListList = ListList & "," & a
         Err.Number = 0
      Next a
      ListList = Mid(ListList, 2)
   On Error GoTo 0
End Function