excel2003如何用vba删除不重复项，提取重复部分的内容（删除多余项，重复里留一条不重复的）？

Question

多人手工录上万条身份证号，想知道哪些内容是重复了的，以便复查。而不是把所有内容直接处理为不重复

Answer 1

其实不需要用到VBA的

一、提示重复(但不阻止输入的重复内容)

在表格中输入身份证号、学号等具有唯一性的数据时，为了防止重复，要求在不小心输入重复值时系统能及时显示提醒信息。

1.方法一：

在Excel2003中我们可以通过设置条件格式来实现。选中需要防止重复的单元格区域，例如：A2:A6000，单击“格式”→“条件格式”，在条件1下拉列表中选择“公式”，在右侧的输入框中输入公式=COUNTIF($A$2:$A$6000,A2)>1。单击“格式”按钮，在“图案”选项卡下单击选择红色，点“确定”完成设置。现在只要A2:A6000区域中出现具有相同内容的单元格，那么这些单元格都会变成红色，也就是说当你输入重复的数据时该单元格就会变红，你马上就可以知道输入的数据重复了。

方法二：在B1格中输入   “=IF(COUNTIF(A:A,A1)>1,"重复","（任意内容）"）”   （不含引号），然后使用下拉句柄填充下面所有表格也可以达到类似效果，而且可以通过筛选过滤数据。

二、阻止重复输入（重复时弹出阻止对话框，适合输入身份证号等维一性的数字）

假设要在A列输入数据，选中A列后，菜单栏，数据，有效性，选自定义，公式那里输入   =countif(a:a,a1)<=1 确定，就能保证输入数据的唯一性，如果输入重复数据就会提示无法输入 

数据--> 有效性-->自定义-->（假设数据在A列）=countif(a:a,a1)<=1

参考资料：http://apps.hi.baidu.com/share/detail/19967033

Answer 2

假设身份证号码在A列，将重复要留下的一个在B列标记：

Sub aa()

    Dim d1, d2

    n = Range("a65536").End(xlUp).Row

    Set d1 = CreateObject("Scripting.Dictionary")

    Set d2 = CreateObject("Scripting.Dictionary")

    i = 1: j = 1

    For Each c In Range("a1:a" & n)

        If c = "" Then GoTo line1

        irow = c.Row

        If d1.exists(c.Value) = False Then

            d1.Add c.Value, i

            i = i + 1

          ElseIf d2.exists(c.Value) = False Then

            d2.Add c.Value, j

            Cells(irow, 2) = "重复(留下)"

            j = j + 1

        End If

line1:

    Next c

End Sub

以B列为主关键字进行排序，把没有"重复(留下)"标记的删除即可，当然，用代码去删除不需要的数据，也是可以的。

追问

继续请教高手：能否提供出对话框，选择是否自动提取所需内容（包含所在行的所有内容）到指定工作表的提示及实现其功能的代码？谢谢

追答

Sub aa()
Dim d1, d2
Dim rng As Range
n = Range("a65536").End(xlUp).Row
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
i = 1: j = 1
For Each c In Range("a1:a" & n)
If c = "" Then GoTo line1
irow = c.Row
Select Case d1.exists(c.Value)
Case False
d1.Add c.Value, i
i = i + 1
Case True
If d2.exists(c.Value) = False Then
d2.Add c.Value, j
If rng Is Nothing Then
Set rng = c
Else: Set rng = Application.Union(rng, c)
End If
j = j + 1
End If
End Select
line1:
Next c
t = MsgBox("检测完成，是否复制重复内容所在行？", vbYesNo)
If t = vbYes Then
rng.EntireRow.Copy
End If
End Sub

本回答被提问者采纳

Answer 3

假设你的身份证号在A列，然后在B列查询重复的，B1的公式为=COUNTIF(A:A,A1)，然后向下填充这个公式，就能找到那些重复了。
=COUNTIF(A:A,A1)的含义是在A列查找和A1单元格内同相同的单元格有几个。
然后筛选，只要B列的值大于1的，肯定是重复了

Answer 4

假设你的身份证号在A列（从A2开始往下），然后在B列查询重复，在B2输入公式：=IF(COUNTIF(A:A,A2)=1,"","重复")，向下填充此公式。在B列筛选就可找到重复了。希望能帮到你！