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

jsh123 · 发表于 2024-1-31 10:36

tanglf188 · 发表于 2024-1-31 10:51

ActiveSheet.Range("$A$2:$C$35").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes

liulang0808 · 发表于 2024-1-31 10:54

手动操作，可以更加辅助列，筛选后删除
代码可以考虑使用字典，案例可以参考
https://club.excelhome.net/threa ... tml?_dsign=b73ad3d6

ykcbf1100 · 发表于 2024-1-31 10:56

本帖最后由 ykcbf1100 于 2024-1-31 10:58 编辑

用数组，附件供参考。。。

ykcbf1100 · 发表于 2024-1-31 10:59

代码以附件为准

Sub ykcbf() '//2024.1.31
Dim arr, d
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
r = .Cells(.Rows.Count, "a").End(xlUp).Row
arr = .[a1].Resize(r, 3)
.[i:k] = ""
.[i1].Resize(UBound(arr), UBound(arr, 2)) = arr
.[i3:k1000] = ""
For i = 3 To UBound(arr)
s = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)
d(s) = d(s) + 1
Next
ReDim brr(1 To UBound(arr), 1 To 3)
For Each k In d.keys
If d(k) = 1 Then
m = m + 1
t = Split(k, "|")
brr(m, 1) = t(0)
brr(m, 2) = t(1)
brr(m, 3) = t(2)
End If
Next
.[i3].Resize(m, 3) = brr
End With
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

复制代码

jsh123 · 发表于 2024-1-31 11:11

谢谢老师！感谢帮助！

limonet · 发表于 2024-1-31 11:12

方法一：=UNIQUE(A2:C34,,TRUE)
方法二：group

limonet · 发表于 2024-1-31 11:12

Sub limonet()
Dim Cn As Object, StrSQL$
Set Cn = CreateObject("Adodb.Connection")
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
StrSQL = "Select 姓名,日期,班次 From [Sheet1$A:C] Group By 姓名,日期,班次 Having Count(*)=1"
Range("E2").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

misterZ · 发表于 2024-1-31 11:16

=IFERROR(INDEX($A$2:$C$35,SMALL(IF(MATCH($A$2:$A$35&$B$2:$B$35&$C$2:$C$35,$A$2:$A$35&$B$2:$B$35&$C$2:$C$35,0)=ROW($A$2:$A$35)-1,ROW($A$2:$A$35)-1,""),ROW(A1)),COLUMN(B1)-1),"")

复制代码

ykcbf1100 · 发表于 2024-1-31 11:19

misterZ 发表于 2024-1-31 11:16

你的公式得改一下，要求是只要重复的行全部删除，很明显，你还保留了唯一。

		自动登录	找回密码
密码			免费注册

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

评分

评分

评分