用这个稳定快,我猜你的数据应该挺多且大,他们的公式带数组溢出需要2019以上的excel,你看下你的office‘版本
Sub 问题()
Dim arr, dic, dic2, i, d, key
Columns("a:c").NumberFormatLocal = "@"
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr, 1), 1 To 2)
Set dic = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
d = 0
For i = 1 To UBound(arr, 1)
If arr(i, 1) <> "" Then
dic(d) = arr(i, 1)
d = d + 1
End If
Next
d = 0
For i = 1 To UBound(arr, 1)
If arr(i, 2) <> "" Then
dic2(d) = arr(i, 2)
d = d + 1
End If
Next
For i = 0 To dic2.Count - 1
For Each key In dic.keys
If dic(key) = dic2(i) Then
dic.Remove key
Exit For
End If
Next
Next
[c1].Resize(dic.Count, 1) = Application.Transpose(dic.items)
End Sub