将第一个列表的每个元素与第二个列表的所有元素进行比较以找到匹配项

时间:2021-04-30 06:56:58

标签: vba

我有两个列表,我试图将它们相互比较,以找出对方没有的列表。

我需要排除重复项,然后找出第一个列表是否包含第二个列表的所有项目。如果没有,我想找出第一个没有的第二个列表中的哪些项目。

这是我尝试过的

Sub CompareLists()

    first = Worksheets("firstworksheet").Range("datalist1").Value2
  
    second = Worksheets("secondworksheet").Range("datalist2").Value2

    
    For i = LBound(first) To UBound(first)
        For j = LBound(second) To UBound(second)
            toCompare1 = LCase(Trim(first(i, 1)))
            toCompare2 = LCase(Trim(second(j, 1)))
            If toCompare1 = toCompare2 Then
                Debug.Print toCompare1 & " -- " & toCompare2
                exit for
            Else
                Debug.Print toCompare1 & " not " & toCompare2
            End If
        Next j
    Next i
End Sub

1 个答案:

答案 0 :(得分:1)

记住声明所有变量(在模块顶部放置 Option Explicit 将帮助您强制执行此操作)。

Private Sub CompareLists()

    Dim first As Variant
    Dim second As Variant
    
    Dim itemMissing As Object
        
    Dim i As Long
    Dim j As Long
    
    first = Application.WorksheetFunction.Transpose(Worksheets("firstworksheet").Range("datalist1").Value)
    second = Application.WorksheetFunction.Transpose(Worksheets("secondworksheet").Range("datalist2").Value)
                                        
    Set itemMissing = CreateObject("Scripting.Dictionary")
    For j = LBound(second) To UBound(second)
        If IsError(Application.Match(second(j), first, 0)) Then 'If Match returns Error = not found
            itemMissing(second(j)) = True
        End If
    Next j
    
    If itemMissing.Count = 0 Then
        Debug.Print "first has all items of second!"
    Else
        Debug.Print "first do not have these values in second:" & vbNewLine & Join(itemMissing.Keys, ", ")
    End If
End Sub