如何计算唯一的逗号分隔值 - Early Bound 与 Late Bound

如何计算唯一的逗号分隔值 - Early Bound 与 Late Bound

我正在尝试在单个单元格中显示一串值中的唯一值(用逗号分隔)。

我遇到过这个解决方案: 如何在 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

但是这需要添加 Microsoft Scripting Runtime 参考。

您发布了一个不需要引用的版本。我只是想知道公式布局/结构是什么?示例:=UNIQUECOUNTIF()?如能提供任何帮助,我将不胜感激。

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

答案1

为了数数怎么样:

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

在此处输入图片描述

为了清单

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

在此处输入图片描述

相关内容