제거 빠른 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