Como posso contar valores separados por vírgula exclusivos - Early Bound vs. Late Bound

Question

Estou tentando exibir valores exclusivos de uma cadeia de valores em uma única célula (separados por uma vírgula).

Eu encontrei esta solução: Como posso contar valores separados por vírgula exclusivos em Excel 2010

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

No entanto, isso requer a adição da referência do Microsoft Scripting Runtime.

Você postou uma versão que não exigia a referência. Eu só estou querendo saber qual é a fórmula layout / estrutura? Exemplo: = UNIQUECOUNTIF ()? Qualquer ajuda seria apreciada.

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

    

Answer 1

Para contar como:

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

Paralistagem:

PublicFunctionListList(SinAsString)AsStringDimcAsCollection,ary,aSetc=NewCollectionary=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