如何用VBA删除表格中某列重复的的数据所在行，只留下其中一个即可。

Question

有个数据库，很庞大，需要针对B列，把B列中重复的数据所在行删除，只需要留一行即可，删除时，要删除重复数据所在行，而不是重复的单元格。要求2003及以上版本都可以使用的VBA编程，谢谢。

急，在线等！
我想要VBA的解决办法，谢谢！

Answer 1

用字典可以轻松快捷地实现去重的操作，代码如下：
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

Answer 2

Sub tt2()
'使用字典删除重复数据，加快运行速度，并增加运行提示
Dim iCol%, i&, n&, m&, r&, d, dd, a, tmp

iCol = [B1].Column '数据源的列位置，需要的话请更改此处

Set d = CreateObject("Scripting.Dictionary") '使用字典
Set dd = CreateObject("Scripting.Dictionary") '使用字典

r = Cells(65536, iCol).End(xlUp).Row
If r < 2 Then MsgBox "只有一行数据，不需整理！": Exit Sub
a = Cells(1, iCol).Resize(r, 1)
For i = 1 To r
tmp = a(i, 1)
If Not d.Exists(tmp) Then d(tmp) = "": dd(i) = ""
Next
n = r - dd.Count
If n > 0 Then
If MsgBox("找到 " & n & " 行重复数据！ 要删除吗？", vbQuestion + vbOKCancel) <> vbOK Then
Exit Sub
End If
Else
MsgBox "没有重复数据，不需整理！": Exit Sub
End If
m = 0
For i = r To 1 Step -1
If Not dd.Exists(i) Then Rows(i).Delete: m = m + 1
Next
MsgBox "找到 " & n & " 行重复数据，删除了 " & m & " 个。", vbInformation
End Sub

Answer 3

Sub tt()
Dim i As Integer
For i = Range("b1").End(xlDown).Row To 1 Step -1
If Application.WorksheetFunction.CountIf(Range(Cells(1, 2), Cells(i, 2)), Cells(i, 2)) > 1 Then
Rows(i).Delete
End If
Next
End Sub
这段代码比较简单你看看
你打开excel alt+f11一起按 插入模块
复制代码 按 F5执行了看看
还有你多少行啊 我写的时候几百行 没问题 不知道几万行卡不卡呢 你看看 有问题联系我吧~追问

是这个as integer的约束吗？不行的话，我改成as long，这样行吗？

追答

我是定义I 为整数 和Range("b1").End(xlDown).Row 对应最大行号的 Long应该也可以的吧
你是要嵌套在别的代码里面用还是什么情况？

本回答被提问者采纳

Answer 4

excel用函数可以实现找出重复的了，然后筛选删除即可。

假设B列中可能有重复的数据，从B2开始有数据，则：C2=countif(B2:B$2,B2)，然后把C列>1的筛选出来，手工全部选中删除就可以了。

注意：从上到下，数据只会保留第一个不重复的数据，如果要从下到上保留第一个不重复的数据，改一下公式即可。