vba代码比较两列数据（VBA利用字典筛选出两列重复与差异数据）

源数据与结果示例：

代码解析：

Sub match11()

Dim arr, brr, drr(), err(), frr(), grr()

Dim i, j, x, lastrowA, lastrowB As Integer

'建立字典对象

Set Da = CreateObject("scripting.dictionary")

Set Db = CreateObject("scripting.dictionary")

'获取数据区域最后一行的行数

lastrowA = Sheets("筛选两列重复与差异").Cells(Rows.Count, 1).End(xlUp).Row

lastrowB = Sheets("筛选两列重复与差异").Cells(Rows.Count, 2).End(xlUp).Row

'将数据区域导入数组

arr = Sheets("筛选两列重复与差异").Range("A2:A" & lastrowA)

brr = Sheets("筛选两列重复与差异").Range("B2:B" & lastrowB)

'遍历数组，写入字典

For i = 1 To UBound(arr)

Da(arr(i, 1)) = ""

Next

For j = 1 To UBound(brr)

Db(brr(j, 1)) = ""

Next

'字典对比，把两列相同的写入D列，以A列为序

'对字典A的关键字进行循环，判断字典B的关键字是否存在，如果存在，就写入数组drr，不存在，就写入字典frr

x = 0

y = 0

For Each k In Da.keys

If Db.exists(k) Then

x = x 1

ReDim Preserve drr(1 To x)

drr(x) = "" & k

Else

y = y 1

ReDim Preserve frr(1 To y)

frr(y) = k

End If

Next

'对字典B的关键字进行循环，判断字典A的关键字是否存在，如果存在，就写入数组err，不存在，就写入字典grr

m = 0

n = 0

For Each k In Db.keys

If Da.exists(k) Then

m = m 1

ReDim Preserve err(1 To m)

err(m) = k

Else

n = n 1

ReDim Preserve grr(1 To n)

grr(n) = k

End If

Next

'将四个数组写入到单元格区域

Range("D2").Resize(x, 1) = Application.Transpose(drr)

Range("E2").Resize(m, 1) = Application.Transpose(err)

Range("F2").Resize(y, 1) = Application.Transpose(frr)

Range("G2").Resize(n, 1) = Application.Transpose(grr)

End Sub

,