remove duplicates faster vb6
i have this function which is slow in removing duplicates in vb6
Function FilterDuplicates(Arr As Variant) As Long
Dim col As Collection, index As Long, dups As Long
Set col = New Collection
On Error Resume Next
For index = LBound(Arr) To UBound(Arr)
' build the key using the array element
' an error occurs if the key already exists
col.Add 0, CStr(Arr(index))
If Err Then
' we've found a duplicate
Arr(index) = Empty
dups = dups + 1
Err.Clear
ElseIf dups Then
' if we've found one or mor开发者_Go百科e duplicates so far
' we need to move elements towards lower indices
Arr(index - dups) = Arr(index)
Arr(index) = Empty
End If
Next
' return the number of duplicates
FilterDuplicates = dups
End Function
I need to optimize this function to run faster, please help
Function FilterDuplicates(Arr As Variant) As Long
Dim col As Dictionary, index As Long, dups As Long
Set col = New Dictionary
On Error Resume Next
For index = LBound(Arr) To UBound(Arr)
' build the key using the array element
' an error occurs if the key already exists
If col.Exists(Arr(index)) Then
' we've found a duplicate
dups = dups + 1
Else
Call col.Add(Arr(index), vbNullstring)
End If
Next
Dim newArr(1 to col.Keys.Count) As Variant
Dim newIndex As Long
For index = LBound(Arr) To UBound(Arr)
If col(Arr(index)) = vbNullstring Then
newIndex = newIndex + 1
col(Arr(index)) = "Used"
newArr(newIndex) = Arr(index)
End If
Next index
Arr = newArr
' return the number of duplicates
FilterDuplicates = dups
End Function
using String concatenation (not too fast with a large array) and InStrB() function:
Function FilterDuplicates(arr As Variant) As Long
Dim item As String, dups As Long, strArray As String
For i = LBound(arr) To UBound(arr)
item = arr(i)
If lenb(item) <> 0 Then
If InStrB(1, strArray, item) = 0 Then
strArray = strArray & item & ";"
Else
dups = dups + 1
End If
End If
Next i
FilterDuplicates = dups
End Function
精彩评论