相同数据的行全部删除一次性删除

demonimissyou

做成图片中的那样不知道满足楼主要求不
Sub 测试()
Dim i, j, k, l, m, d, STR, arr, brr
Set d = CreateObject("scripting.dictionary")
i = [C65536].End(xlUp).Row
arr = Range("A2:E" & i)
For j = 1 To UBound(arr)
STR = arr(j, 2) & arr(j, 3)
If d.exists(STR) Then
l = d(STR)
If arr(l, 4) <> arr(j, 4) Then
arr(l, 5) = arr(j, 4)
Else
arr(l, 5) = ""
End If
Else
k = k + 1
d(STR) = k
arr(k, 1) = arr(j, 1)
arr(k, 2) = arr(j, 2)
arr(k, 3) = arr(j, 3)
arr(k, 4) = arr(j, 4)
End If
Next
[F2].Resize(d.Count, 5) = arr
End Sub