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：集合对象的内部联接

1 个答案: