vba去除重复项

vba去除重复项，可以考虑使用字典

Sub 按钮1_Click()

Set d = CreateObject("scripting.dictionary")

Set Rng = Nothing

arr = [a1].CurrentRegion

Application.ScreenUpdating = False

For j = 1 To UBound(arr)

If d.exists(arr(j, 1)) Then

If Rng Is Nothing Then

Set Rng = Cells(j, 1)

Else

Set Rng = Union(Rng, Cells(j, 1))

End If

Else

d(arr(j, 1)) = ""

End If

Next j

If Not Rng Is Nothing Then Rng.EntireRow.Delete

Application.ScreenUpdating = True

End Sub

代码运行前的数据

代码运行后，仅仅保留不重复项目

软件版本：Office2007

方法如下：

1.选择要删除重复项的数据区域：

2.Alt+F11，在当前工作表中输入代码如下：

Sub m()

首行 = Selection(1).Row

尾行 = Selection(Selection.Count).Row

列 = Selection(Selection.Count).Column

For i = 首行 To 尾行

If Application.CountIf(Range(Cells(i, 列), Cells(尾行, 列)), Cells(i, 列)) >1 Then

Cells(i, 列) = ""

End If

Next i

End Sub

3.F5执行代码，返回Excel，得到结果如下：

用字典可以轻松快捷地实现去重的 *** 作，代码如下：

Sub main()

Set dic = CreateObject("scripting.dictionary") '创建字典对象，并把字典对象赋给变量dic；这是最常用的一句代码，也就是所谓的“后期绑定”

For i = Range("B65536").End(3).Row To 1 Step -1 '从B列的最后一行到第一行依次递减，如果是从第一行到最后一行递增，则会因为删除行而跳过很多行，达不到去重效果

If dic.exists(Cells(i, "B").Value) Then '如果B列中的数据已经在字典中了（也就是重复了）

Rows(i).Delete '就删除这一行

Else

dic(Cells(i, "B").Value) = "" '否则就把B列的数据放入字典中

End If

Next i

End Sub

---