删除两列数据同时相同的重复数据

一把小刀闯天下

'假设B、C列有序，，，

Option Explicit

Sub test()
  Dim arr, i, j, m, p
  arr = [a1].CurrentRegion.Offset(1)
  For i = 1 To UBound(arr, 1) - 1
    If arr(i, 2) <> arr(i + 1, 2) And arr(i, 3) <> arr(i + 1, 3) Then
      m = m + 1
      For j = 1 To UBound(arr, 2): arr(m, j) = arr(p + 1, j): Next
      p = i
    End If
  Next
  With [a2]
    .Resize(UBound(arr, 1), UBound(arr, 2)).ClearContents
    .Resize(m, UBound(arr, 2)) = arr
  End With
End Sub

shentu88

一把小刀闯天下 发表于 2019-5-30 14:05
'假设B、C列有序，，，

Option Explicit

谢谢 非常感谢

zhangcheng6688

lsdongjh 发表于 2019-5-30 13:41

学习了，谢谢！！！

zhangcheng6688

学习一下字典，感谢
Sub test()
arr = [a1].CurrentRegion
Set d = CreateObject("scripting.dictionary")
ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
For i = 2 To UBound(arr)
   ss = arr(i, 2) & arr(i, 3)
   If Not d.exists(ss) Then
      d(ss) = ""
      m = m + 1
      For j = 1 To UBound(arr, 2)
         brr(m, j) = arr(i, j)
      Next
   End If
Next
If m > 0 Then
   [a1].CurrentRegion.Offset(1).ClearContents
   [a2].Resize(m, UBound(brr, 2)) = brr
End If
End Sub