我有两个收藏。如何创建一个新的Collection来提取现有两个Collections之间的差异?

时间:2016-09-06 22:03:07

标签: vba excel-vba excel

对于罗嗦的标题感到抱歉!我有一个主集合,我们称之为List1,以及一个二级集合,我们称之为List2。我想创建List3,它由List1和List2之间的差异组成。我将变量定义为集合,因为List2是动态的并且长度发生了变化(代码未显示)。

Dim List1 As New Collection
Dim List2 As New Collection

With List1
    .Add "Soap"
    .Add "Toothbrush"
    .Add "Toothpaste"
    .Add "Showercap"
    .Add "Shampoo"
End With

With List2
    .Add "Toothbrush"
    .Add "Toothapste"
    .Add "Shampoo"
End With

理想情况下,List3应该是一个仅包含“Soap”和“Showercap”的新集合。

任何帮助将不胜感激!感谢。

3 个答案:

答案 0 :(得分:1)

这比Collection更适合Scripting.Dictionary,因为Collection没有.Exists函数:

Dim list1 As New Scripting.Dictionary
Dim list2 As New Scripting.Dictionary

With list1
    .Add "Soap", vbNull
    .Add "Toothbrush", vbNull
    .Add "Toothpaste", vbNull
    .Add "Showercap", vbNull
    .Add "Shampoo", vbNull
End With

With list2
    .Add "Toothbrush", vbNull
    .Add "Toothpaste", vbNull
    .Add "Shampoo", vbNull
End With

Dim differences As New Scripting.Dictionary
Dim key As Variant
For Each key In list1.Keys
    If Not list2.Exists(key) Then differences.Add key, vbNull
Next

For Each key In list2.Keys
    If Not list1.Exists(key) Then differences.Add key, vbNull
Next

For Each key In differences
    Debug.Print key
Next

注意 - 这需要引用“Microsoft Scripting Runtime”。你可以从菜单中添加一个带有Tools-> References ...,然后找到它并选中它旁边的复选框。

答案 1 :(得分:0)

我会:

1)创建一个函数来查看该项是否存在 2)然后通过循环检查每个集合 3)如果找不到,则添加到第3个集合

例如

Sub test()

Dim List1 As New Collection
Dim List2 As New Collection
Dim List3 As New Collection

With List1
    .Add "Soap"
    .Add "Toothbrush"
    .Add "Toothpaste"
    .Add "Showercap"
    .Add "Shampoo"
End With

With List2
    .Add "Toothbrush"
    .Add "Toothpaste"
    .Add "Shampoo"
End With

For Each Item In List1
    If Not Exists(List2, Item) Then
        List3.Add (Item)
    End If
Next

For Each Item In List2
    If Not Exists(List1, Item) Then
        List3.Add (Item)
    End If
Next

End Sub


Public Function Exists(col As Collection, key As Variant) As Boolean
    Exists = False

    For Each elm In col
        If key = elm Then
            Exists = True
            Exit Function
        End If
    Next
End Function

答案 2 :(得分:0)

假设(根据你的例子)集合元素是String s,我建议你使用以下“开箱即用”的方法:

已修改以考虑可能的子字符串并修正拼写错误

Option Explicit

Sub Main()
    Dim List1 As New Collection
    Dim List2 As New Collection
    Dim List3 As Collection

    With List1
        .Add "Soap"
        .Add "Toothbrush"
        .Add "Toothpaste"
        .Add "Showercap"
        .Add "Shampoo"
    End With

    With List2
        .Add "Toothbrush"
        .Add "Toothpaste"
        .Add "Shampoo"
    End With

    Set List3 = GetDifferenceList(List1, List2)

End Sub


Function GetDifferenceList(List1 As Collection, List2 As Collection) As Collection
    Dim list1Strng As String
    Dim c As New Collection
    Dim elem As Variant

    list1Strng = GetListString(List1)
    For Each elem In List2
        list1Strng = Replace(list1Strng, "|" & CStr(elem) & "|", "|")
    Next elem
    list1Strng = Replace(list1Strng, "||", "|")
    list1Strng = Mid(list1Strng, 2, Len(list1Strng) - 2)

    For Each elem In Split(list1Strng, "|")
      c.Add elem
    Next elem

    Set GetDifferenceList = c
End Function


Function GetListString(List As Collection) As String
    Dim elem As Variant

    For Each elem In List
        GetListString = GetListString & CStr(elem) & "|"
    Next elem
    GetListString = "|" & GetListString
    GetListString = Replace(GetListString, "||", "|")
End Function