удаляйте дубликаты быстрее vb6

Question

У меня есть эта функция, которая медленно удаляет дубликаты в 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 more 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

Мне нужно оптимизировать эту функцию, чтобы она работала быстрее, помогите

Answer 1

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