удалить дублирует быстрее 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