Sub CheckDiff()
Dim r%, i%
Dim arr, brr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Worksheets("sheetName")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:a" & r)
For i = 1 To UBound(arr)
d(arr(i, 1)) = ""
Next
r = .Cells(.Rows.Count, 2).End(xlUp).Row
arr = .Range("b2:b" & r)
ReDim brr(1 To UBound(arr), 1 To 1)
m = 0
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 1)) Then
m = m + 1
brr(m, 1) = arr(i, 1)
End If
Next
.Range("c2").Resize(m, 1) = brr
End With
End Sub
VBA兩列去重並提取不重複數據到新列
發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.