VBA Set Intersections

intersection.vba

Option Explicit

Sub IntersectionMacro()

    Dim set1 As New Scripting.Dictionary
    Dim set2 As New Scripting.Dictionary
    Dim result As New Scripting.Dictionary
    
    set1.Add "M AB 123", ""
    set1.Add "M CD 456", ""
    set1.Add "M EF 789", ""
    set1.Add "B AA 22", ""
    
    set2.Add "M CD 456", ""
    set2.Add "J GH 000", ""
    set2.Add "M EF 789", ""
    set2.Add "B AA 22", ""
    set2.Add "EF ZZ 111", ""
    
    Intersect set1, set2, result
    
    Dim Key As Variant
    Dim i As Integer
    i = 1
    
    For Each Key In result.Keys
        Cells(i, 1) = Key
        i = i + 1
    Next Key
End Sub


Sub Intersect(set1 As Scripting.Dictionary, set2 As Scripting.Dictionary, ByRef result As Scripting.Dictionary)
    Dim Key As Variant
    
    For Each Key In set1.Keys
        If set2.Exists(Key) Then
            result.Add Key, ""
        End If
    Next Key
End Sub

Unter Extras -> Verweise ...

... muss die "Microsoft Scripting Runtime" aktiviert werden

Ergebnis: Schnittmenge aus den beiden Mengen von Kennzeichen