比较VBA中的列表和Msgbox中的输出差异

我有两个数据列表。 第一个列表是一个包含所有新数据的列表，而在第二个列表中我有旧数据。现在我想让Excel显示一个消息框，告诉我第二个列表中缺少哪些数据

使用在其他主题中找到的信息，我能够相互比较这两个列表，并在第三页中输出这些数据。 然而，我并不真的需要第三张纸，但我希望在消息框中显示这些差异：）有谁能帮我正确地修改代码吗

Sub Compare()

Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long, rng1 As Range, rng2 As Range, c As Range
Set sh1 = Sheets(1)
Set sh2 = Sheets(2)
Set sh3 = Sheets(3)
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = sh1.Range("A2:A" & lr1)
Set rng2 = sh2.Range("A2:A" & lr2)

With sh3 'If header not there, put them in
    If .Range("a1") = "" Then
       .Range("a1") = "Extras in List 2"
    End If
End With

    For Each c In rng2
        If Application.CountIf(rng1, c.Value) = 0 Then
        sh3.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
        End If
    Next

End Sub

---

未测试-直接在SO中输入，但应显示方式：（在

之后开始，以
结束）

@帕特里克霍诺雷斯有更好的答案，因为他修正了OP的密码

每当比较两个列表时，我都使用某种集合或字典

我的方法是将第二个列表中的所有值添加到ArrayList，然后从ArrayList中删除第一个列表值。这样，ArrayList中只剩下新值

Sub Compare()
    Dim cell As Range, list As Object
    Set list = CreateObject("System.Collections.ArrayList")

    With Worksheets(2)
        For Each cell In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
            If cell.Value <> "" Then
                If Not list.Contains(cell.Value) Then list.Add cell.Value
            End If
        Next
    End With

    With Worksheets(1)
        For Each cell In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
            If list.Contains(cell.Value) Then list.Remove cell.Value
        Next
    End With

    With Worksheets(3)
        .Columns(1).ClearContents
        .Range("A1") = "Extras in List 2"

        If list.Count = 0 Then
            MsgBox "No new data", vbInformation, ""
        Else
            MsgBox Join(list.ToArray, ", "), vbInformation, "New Data"
            .Range("A2").Resize(list.Count).Value = Application.Transpose(list.ToArray)
        End If
    End With
End Sub

子比较（）
将单元格设置为范围，列表设置为对象
Set list=CreateObject（“System.Collections.ArrayList”）
附工作表（2）
对于.Range（“A2”、.Range（“A”&.Rows.Count）.End（xlUp））中的每个单元格
如果单元格的.Value为“”，则
如果不是list.Contains（cell.Value），则是list.Add cell.Value
如果结束
下一个
以
附工作表（1）
对于.Range（“A2”、.Range（“A”&.Rows.Count）.End（xlUp））中的每个单元格
如果list.Contains（cell.Value），则list.Remove cell.Value
下一个
以
附工作表（3）
.列（1）.ClearContents
.Range（“A1”）=“列表2中的附加项”
如果list.Count=0，则
MsgBox“无新数据”，vbInformation“
其他的
MsgBox联接（list.ToArray，“，”），vbInformation，“新数据”
.Range（“A2”）.Resize（list.Count）.Value=Application.Transpose（list.ToArray）
如果结束
以
端接头
谢谢你的帮助，帕特里克！它几乎可以工作，但是现在它显示了一条信息：“额外的：，，6，8”你知道如何解决这个问题吗？我发现我以前的问题在哪里，我也有一些空白行，它们也被确定为“新的”。但是，代码需要忽略空行，因为新代码导致sintax错误。它与行“If len（c）.Value>0和Application.CountIf（rng1，c.Value）=0有关”。。有什么想法吗？如果
，双
——很容易发现——而且
len（c.Value）
现在可以完美地工作了！谢谢！我还有最后一个问题，如果没有差异，你能对代码进行编程，这样就不会发生任何事情吗？（所以没有留言）谢谢托马斯。如果我必须从头开始做类似的事情，我可能会使用带有左连接的ADO查询。谢谢你的贡献，托马斯，这似乎也能起作用，但是这一个在它的“差异”列表中也包括空白单元格。你知道如何排除这些吗？
Sub Compare()
    Dim cell As Range, list As Object
    Set list = CreateObject("System.Collections.ArrayList")

    With Worksheets(2)
        For Each cell In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
            If cell.Value <> "" Then
                If Not list.Contains(cell.Value) Then list.Add cell.Value
            End If
        Next
    End With

    With Worksheets(1)
        For Each cell In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
            If list.Contains(cell.Value) Then list.Remove cell.Value
        Next
    End With

    With Worksheets(3)
        .Columns(1).ClearContents
        .Range("A1") = "Extras in List 2"

        If list.Count = 0 Then
            MsgBox "No new data", vbInformation, ""
        Else
            MsgBox Join(list.ToArray, ", "), vbInformation, "New Data"
            .Range("A2").Resize(list.Count).Value = Application.Transpose(list.ToArray)
        End If
    End With
End Sub