Question

i 本功能在去除第6条中的重复

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

I need to optimize this function to run faster, please help

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

Answer 2

利用强调(而不是大量)和InStrB()功能:

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

友情链接