使用VBA在excel中匹配2列中多次出现的值

Sub MatchDuplicates()
    Dim ws As Worksheet
    Dim rng1 As Range, rng2 As Range
    Dim cell As Range
    Dim dict As Object
    Dim result As String
    
    ' 设置工作表和要匹配的范围
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' 替换为实际的工作表名称
    Set rng1 = ws.Range("A1:A10") ' 替换为实际的第一列范围
    Set rng2 = ws.Range("B1:B10") ' 替换为实际的第二列范围
    
    ' 创建字典对象
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 遍历第一列，将值添加到字典中
    For Each cell In rng1
        If Not dict.exists(cell.Value) Then
            dict.Add cell.Value, 1
        End If
    Next cell
    
    ' 遍历第二列，检查是否存在于字典中
    For Each cell In rng2
        If dict.exists(cell.Value) Then
            result = result & cell.Value & ", "
        End If
    Next cell
    
    ' 输出匹配结果
    If Len(result) > 0 Then
        MsgBox "匹配的值为：" & Left(result, Len(result) - 2)
    Else
        MsgBox "没有匹配的值。"
    End If
End Sub