vba取旁边一列的数据取两列数据的相同值

导读本例介绍用字典取两列数据的相同项，如图，A列为2018年500强名单，B列为2019年名单，要求取得这两年连续上榜名单，也就是取两列的相同项。代码：SubC....本例介绍用字典取两列数据的相同项，如图，A列为2018年500强名单，B列为2019年名单，要求取得这两年连续上榜名单，也就是取两列的相同项。

代码：

Sub Ck()

Set d = CreateObject("Scripting.Dictionary")

arr1 = Range([A2], [A65536].End(xlUp))

arr2 = Range([B2], [B65536].End(xlUp))

For i = 1 To UBound(arr1)

d(arr1(i, 1)) = 0

Next

For j = 1 To UBound(arr2)

If d.exists(arr2(j, 1)) Then d(arr2(j, 1)) = 1

Next

For Each d1 In d.keys

If d(d1) = 0 Then d.Remove (d1)

Next

Range("C2").Resize(d.Count, 1) = WorksheetFunction.Transpose(d.keys)

End Sub

结果如图：

代码解析：

arr1 = Range([A2], [A65536].End(xlUp)) ’建立数组，将A列相应的值放入数组放入arr1

arr2 = Range([B2], [B65536].End(xlUp)) ’建立数组，将B列相应的值放入数组放入arr2

For i = 1 To UBound(arr1)

d(arr1(i, 1)) = 0 ’将arr1的值写入字典的key，其item值等于0

Next

For j = 1 To UBound(arr2)

If d.exists(arr2(j, 1)) Then d(arr2(j, 1)) = 1 ’如有B列的数值等于字典的key，那么，将其对应key的item赋值为1

Next

For Each d1 In d.keys

If d(d1) = 0 Then d.Remove (d1) ‘删除字典中item为0的值，剩余的为item为1的值，也就是获得了两列的重复项

Range("C2").Resize(d.Count, 1) = WorksheetFunction.Transpose(d.keys)

‘转置，在C列列出重复值。