大家好，今日我们继续讲解VBA数组与字典解决方案，今日讲解第52讲：利用字典，提取两列数据重复值。有人讲:字典是VBA中最为精华的部分,持这种观点的人肯定有自己的道理,确实,利用字典可以给我的代码带来很大的方便之处,今日我讲解的是利用字典,提取两列的重复数据.在实际的工作中排重和提取重复的数据是很常见的工作,如果直接进行比较核对,真的很费事费时,之前我讲过数据库的方法,不失为一种好的方案.今日我们讲解利用字典的方法,这也是一种非常好的方案.

实例,下面的AB列数据,我们要提取出在A中与B列重复的数据,该如何进行?

我们首先看看数据,很多是重复的,我们首先要进行排重处理,一般的方案难于应付,下面看我给出的字典方案代码:

Sub mynzsz_52() '第52讲 利用字典，提取两列数据重复值

Sheets("52").Select

Set mydic = CreateObject("Scripting.Dictionary")

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

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

For i = 1 To UBound(myarr1)

'将键值赋值为0

mydic(myarr1(i, 1)) = 0

Next

For j = 1 To UBound(myarr2)

'如果数组2在字典中存在相应的键，那么将键值更改为1

If mydic.exists(myarr2(j, 1)) Then mydic(myarr2(j, 1)) = 1

Next

'对于字典中的每个键进行判断，如果相应的键值为0，也就是说在数组2中不存在，那么移除

For Each d In mydic.keys

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

Next

'将字典数据回填到工作表

[e:e].ClearContents

Range("e1") = "A列中与B列重复的值"

Range("e2").Resize(mydic.Count, 1) = WorksheetFunction.Transpose(mydic.keys)

End Sub

代码截图:

代码解析:

1 上述代码实现了提取重复数据并排重的功能,代码简洁,操作灵活.

2. Set mydic = CreateObject("Scripting.Dictionary")

上述代码创建了一个字典

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

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

上述代码分别将两列数据放到数组中.

4 For i = 1 To UBound(myarr1)

'将键值赋值为0

mydic(myarr1(i, 1)) = 0

Next

将数组1的数据放到字典的键中同时键值赋值为0

5 For j = 1 To UBound(myarr2)

'如果数组2在字典中存在相应的键，那么将键值更改为1

If mydic.exists(myarr2(j, 1)) Then mydic(myarr2(j, 1)) = 1

Next

在数组2中建立循环,如果在字典中存在相应的键,那么将键值更正为1

6 For Each d In mydic.keys

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

Next

将字典中的数据进行处理,假如键值为0,那么移除

7 '将字典数据回填到工作表

[e:e].ClearContents

Range("e1") = "A列中与B列重复的值"

Range("e2").Resize(mydic.Count, 1) = WorksheetFunction.Transpose(mydic.keys)

上述代码数据回填.

下面看代码的运行:

今日内容回向:

1 利用字典如何获取重复数据的值?

2 上述代码中为什么要对键值重新赋值?