删除A,B,C三列同时重复所有整行数据，不留唯一

boyayes

字典+数组，就轻松解决了哦。

无关岁月

副本新建 XLSX 工作表.7z (19.53 KB, 下载次数: 10)

2024-1-31 11:57 上传

点击文件名下载附件

cjc209

zhangcheng6688

学习一下
Sub test()
lastr = Cells(Rows.Count, "c").End(xlUp).Row
arr = Range("a1:c" & lastr)
ReDim brr(1 To UBound(arr), 1 To 3)
For i = 3 To UBound(arr)
   If arr(i, 1) <> "" Then
      flag = False
      For k = i + 1 To UBound(arr)
         If arr(k, 1) <> "" Then
            If arr(i, 1) = arr(k, 1) And arr(i, 2) = arr(k, 2) And arr(i, 3) = arr(k, 3) Then
               arr(k, 1) = vbNullString
               flag = True
            End If
         End If
      Next
      If flag = True Then
          GoTo x
      End If
      m = m + 1
      For j = 1 To UBound(arr, 2)
         brr(m, j) = arr(i, j)
      Next
   End If
x:
Next
[i3].Resize(m, 3) = brr
End Sub

gwjkkkkk

Option Explicit
Sub TEST5()
    Dim ar, br, i&, dic As Object, vKey
   
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = Range("A3", Cells(Rows.Count, "C").End(xlUp)).Value
    For i = 1 To UBound(ar)
        vKey = Join(Application.Index(ar, i))
        dic(vKey) = dic(vKey) + 1
    Next i
    For Each vKey In dic.keys
        If dic(vKey) > 1 Then
            dic.Remove vKey
        Else
            dic(vKey) = Split(vKey)
        End If
    Next vKey
   
    [M3].Resize(dic.Count, 3) = Application.Rept(dic.items, 1)
    Set dic = Nothing
    Beep
End Sub

gwjkkkkk

参与一下。。。