Excel VBA: 集合对象的内部连接

Question

我正在尝试对 Excel 中的集合实施内部联接，但我没有看到这会生成准确的对象列表。我看到的不是每个匹配项一个条目，而是结果中第一个列表中的所有条目：

    'Public Functions
Public Function innerJoin(ByVal col1 As Collection, ByVal col2 As Collection) As Collection

Dim i As Integer
Dim searchValue As Integer
Dim totRemoved As Integer
totRemoved = 0

Dim tempCol As Collection
Set tempCol = New Collection
Dim tempCol2 As Collection
Set tempCol2 = New Collection

    For i = 1 To col2.Count
        tempCol2.Add col2.Item(i)
    Next i

For i = 1 To col1.Count

    searchValue = searchCollection(tempCol2, col1.Item(i))
    If searchValue = 0 Then
        tempCol2.Remove i - totRemoved
    totRemoved = totRemoved + 1
    Else
        tempCol.Add col1.Item(i)
    End If

Set innerJoin = tempCol

Next i

searchCollection 的代码已经过全面的单元测试。

Answer 1

除非我遗漏了您的要求，否则您的代码似乎比需要的要复杂得多。特别是——为什么将东西添加到集合中只是为了稍后删除它们？如果包含对 Microsoft Scripting Runtime 的引用（在 VBA 编辑器中的 Tools/References 下），字典似乎是一个自然的选择。以下对您有用吗？

Function Intersect(col1 As Collection, col2 As Collection) As Collection
    Dim intCol As New Collection
    Dim colDict As New Dictionary
    Dim v As Variant

    'Create dictionary of objects in col2
    For Each v In col2
        colDict.Add v, 0
    Next v

    'loop through col1, adding items in colDict to intCol
    For Each v In col1
        If colDict.Exists(v) Then intCol.Add v
    Next v
    Set Intersect = intCol
End Function

这是一个测试：

Sub test()
    Dim Moods As New Collection
    Dim Colors As New Collection
    Dim ColorMoods As Collection
    Dim v As Variant

    Moods.Add "Sad"
    Moods.Add "Happy"
    Moods.Add "Blue"
    Moods.Add "Black"
    Moods.Add "Content"

    Colors.Add "Yellow"
    Colors.Add "Green"
    Colors.Add "Red"
    Colors.Add "Blue"
    Colors.Add "White"
    Colors.Add "Black"

    Set ColorMoods = Intersect(Moods, Colors)
    For Each v In ColorMoods
        Debug.Print v
    Next v
End Sub

输出：

Blue
Black

Excel VBA: 集合对象的内部连接

Excel VBA: Inner Join on Collection Objects

excel

vba

join

set