Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement