开发者

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
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜