源數據與結果示例：

代碼解析：

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

更多精彩资讯请关注tft每日頭條，我们将持续为您更新最新资讯!