[英]For all unique cells in a row, delete rows
I need to delete the rows for all cells in column "E" that are unique, so I have only "NON-Unique" cells in column ie Column "E" has only duplicates. 我需要删除“ E”列中所有单元格的唯一行,因此列中只有“ NON-Unique”单元格,即“ E”列中只有重复项。
I have been searching for code to do this but have found very little. 我一直在寻找执行此操作的代码,但是却很少。
Sorry I cant even post a snip-it to start off with. 抱歉,我什至无法发布摘要。
Thanks 谢谢
Give this a try: 试试看:
Sub RemoveUniques()
Dim E As Range, rDel As Range, r As Range, N As Long
N = Cells(Rows.Count, "E").End(xlUp).Row
Set E = Range("E1:E" & N)
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
Set rDel = Nothing
For Each r In E
v = r.Value
If wf.CountIf(E, v) = 1 Then
If rDel Is Nothing Then
Set rDel = r
Else
Set rDel = Union(rDel, r)
End If
End If
Next r
If Not rDel Is Nothing Then
rDel.EntireRow.Delete
End If
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.