access VBA如何从集合中删除重复项

Question

如何删除集合中重复的对象？这是我尝试过的：

    dim unique_students as Collection
    dim no_duplicate_student as cls_Student
    dim no_duplication as boolean

For Each student as cls_Student In list_Student 'list_Students = original unsorted collection

         no_duplication = True

         Dim s As cls_Student
         For Each s In unique_students

            If s.name = student.name  Then 
               no_duplication = False 'Duplication found
               Exit For
            End If

         next s

         If no_duplication Then 
'Inserted into new sorted collection if no values matches that of the sorted collection

           Set no_duplicate_student = New clsOverlap
           no_duplicate_student.name = student.name

           unique_students.Add no_duplicate_student

         End If

Next student

然而，这仍然需要很长的时间(if list_Student.Count > 5000，然后运行30min+ )。有没有一种更有效的方法(如果可能的话，降低时间复杂度)来删除集合中的重复项？

Answer 1

将学生姓名添加到字典中，它使用.Exists方法检查字典中是否已经存在某个条目。

您可以从Collection And Dictionary Procedures中的CollectionToDictionary获得一些想法

在您的For Each student循环中如下所示：

If Dict.Exists(Key:=student.name) Then
    ' is duplicate!
Else
    Dict.Add Key:=student.name, Item:=student.name
    ' you could also do Item:=student if you want the de-duplicated list in a dictionary
End If

不需要内部循环。该函数可能几乎是瞬间运行的。

Answer 2

我通常使用Andre451推荐的字典。或者，您可以使用这样的ArrayList。我不确定这两者之间是否有很大的性能差异，但是如果需要的话，这个方法也会产生一个排序列表。不过，字典可以携带键/值对，因此它只取决于您要查找的内容。

Sub Demo()
    Set AL = CreateObject("System.Collections.ArrayList")
    AL.Add "A"
    AL.Add "B"
    AL.Add "A"
    AL.Add "A"
    AL.Add "C"
    'Sorting allows sequential comparisons to determine uniqueness
    'You could also do something similar to the dictionary method with ArrayList.Contains 
    'but the evluation of ArrayList.Contains runs slower than this
    AL.Sort
    For i = 0 To AL.Count - 2
        If AL(i) <> AL(i + 1) Then
           'Prints unique values
            Debug.Print AL(i)
        End If
    Next
    If AL(i) <> AL(i - 1) Then
        'Prints last value if unique by comparing to one before it
        Debug.Print AL(i)
    End If
End Sub

编辑：经过测试，我确认字典方法的速度大约是7.7秒的两倍，而不是13秒/百万。但是，在OP计数为5000时，差异仅为40ms与80ms。

在此测试代码...

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long
Sub DictionaryDemo()
    Set D = CreateObject("Scripting.Dictionary")
    Set AL = CreateObject("System.Collections.ArrayList")
    For i = 0 To 10 ^ 6
        AL.Add Round(Rnd * 10, 0)
    Next

    Start = GetTickCount
    For i = 0 To AL.Count - 1
        If Not (D.Exists(AL(i))) Then
            D.Add AL(i), ""
            Debug.Print AL(i)
        End If
    Next
    Debug.Print GetTickCount - Start
End Sub
Sub ArrayListDemo()
    Set AL = CreateObject("System.Collections.ArrayList")
    For i = 0 To 10 ^ 6
        AL.Add Round(Rnd * 10, 0)
    Next

    'Sorting allows sequential comparisons to determine uniqueness
    Start = GetTickCount
    AL.Sort
    For i = 0 To AL.Count - 2
        If AL(i) <> AL(i + 1) Then
           'Prints unique values
            Debug.Print AL(i)
        End If
    Next
    If AL(i) <> AL(i - 1) Then
        'Prints last value if unique by comparing to one before it
        Debug.Print AL(i)
    End If
    Debug.Print GetTickCount - Start
End Sub

再次编辑： Ok，所以我觉得这很有趣。最重要的似乎是实际的类型本身。因此，例如，上面的测试创建了一个ArrayList，从中派生出唯一的值。如果将其更改为基本整数数组Dim AL(10 ^ 6) As Integer，则时间将从7.7秒大幅减少到0.8秒。同样，只需在排序操作后添加行A = AL.ToArray并循环数组A，就可以将ArrayList方法从13秒减少到0.5秒。

这是有意义的，因为数组的内存分配允许它们被处理得非常快。这也是为什么有些人更喜欢创建自己的排序和唯一性算法，而不是像这里最初建议的那样，使用效率较低但易于使用的方法使用字典或ArrayList。字典和ArrayLists仍然是强大的工具，如上所述，它们仍然可以在几分之一秒内从一百万个长度中提取唯一值，但值得注意的是，在原始效率方面，简单的数组循环速度非常快。

下面的代码将在大约0.3秒内从一百万长度的数组中提取唯一值。它与OP没有太大不同，但它的效率要高得多。这是因为循环遍历集合的速度非常慢，而不是因为基本策略有任何低效之处。此外，请注意，随着唯一值的数量增加，效率将会降低(此测试仅使用1- 10中的10个唯一值)。

Sub ArrayDemo()
    Dim A(10 ^ 6) As Integer
    Dim B(10) As Integer
    For i = 0 To 10 ^ 6
        A(i) = Round(Rnd * 10, 0)
    Next

    Start = GetTickCount
    k = 0
    For i = 0 To 10 ^ 6
        For j = 0 To k
            If B(j) = A(i) Then GoTo nxt
        Next
        B(k) = A(i)
        Debug.Print B(k)
        k = k + 1  
nxt:
    Next
    Debug.Print GetTickCount - Start
End Sub