Excel中删除重复数据

Excel中删除重复数据(用VBA代码) 第一种情况保留不重复的记录行，重复的只保留一行。 1、打开有重复数据的EXCEL 2、Alt+F11 打开宏的VB编辑器 3、左边双击：ThisWorkBook 4、贴入以下代码并运行即可： Sub 删除重复数据() '删除col列的重复数据 '本例是删除标为sheet1的EXCEL中A列（从A2单元格开始）的重复数据 Application.ScreenUpdating = False '可根据实际情况修改下面三行的结尾值 Dim sheetsCaption As String: sheetsCaption = "Sheet1" Dim Col As String: Col = "A" Dim StartRow As Integer: StartRow = 2 '以下不需要修改 Dim EndRow As Integer: EndRow = Sheets(sheetsCaption).Range(Col & "65536").End(xlUp).Row Dim Count_1 As Integer: Count_1 = 0 Dim count_2 As Integer: count_2 = 0 Dim i As Integer: i = StartRow With Sheets(sheetsCaption) Do Count_1 = Count_1 + 1 For j = StartRow To i - 1 If .Range(Col & i) = .Range(Col & j) Then Count_1 = Count_1 - 1 .Range(Col & i).EntireRow.Delete EndRow = Sheets(sheetsCaption).Range(Col & "65536").End(xlUp).Row i = i - 1 count_2 = count_2 + 1 Exit For End If Next i = i + 1 Loop While i < EndRow + 1 End With MsgBox "共有" & Count_1 & "条不重复的数据" MsgBox "删除" & count_2 & "条重复的数据" Application.ScreenUpdating = True End Sub 5、按F5键运行即可 ====================================分段====================================== 第二种情况：先删除不重记录行，然后保留一行重复的，代码如下： Private Sub CommandButton1_Click() Dim 提示信息 Dim 最后行号 Dim 循环计数 Dim 重复数 Dim 筛选列 Dim 升降序 '根据需要设定筛选列 筛选列 = "B" '禁止屏幕刷新 Application.ScreenUpdating = False 提示信息 = MsgBox("先删除不重复的行吗？", vbOKCancel, "警告：") If 提示信息 = 1 Then '先删除不重复的 最后行号 = Range(筛选列 & "65536").End(xlUp).Row For 循环计数 = 最后行号 To 2 Step -1 '不处理首行的标题栏 重复数 = Application.WorksheetFunction.CountIf(Range(筛选列 & ":" & 筛选列), Range(筛选列 & Format(循环计数))) 'vba中调用Excel内置数CountIf() If 重复数 = 1 Then Rows(Format(循环计数) & ":" & Format(循环计数)).Delete End If Next 循环计数 End If '再删除重复的(保留1行) 提示信息 = MsgBox("现在删除重复数据只保留1行吗？", vbOKCancel, "警告：") If 提示信息 = 1 Then 最后行号 = Range(筛选列 & "65536").End(xlUp).Row For 循环计数 = 最后行号 To 2 Step -1 '不处理首行的标题栏 重复数 = Application.WorksheetFunction.CountIf(Range(筛选列 & ":" & 筛选列), Range(筛选列 & Format(循环计数))) 'vba中调用Excel内置函数CountIf() 盈搜财税 www.ringsou.com If 重复数 > 1 Then Rows(Format(循环计数) & ":" & Format(循环计数)).Delete End If Next 循环计数 End If '恢复屏幕刷新 Application.ScreenUpdating = True '将结果排序(去掉下面的注析就可用) '最后行号 = Range(筛选列 & "65536").End(xlUp).Row '升降序 = xlAscending '升序：升降序 = xlAscending 降序：升降序 = xlDescending 'On Error Resume Next 'Range(筛选列 & 最后行号).Sort Key1:=Range(筛选列 & "2"), Order1:=升降序, Header:=xlGuess, _ 'OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _ ':=xlPinYin 'If Err <> 0 Then MsgBox "“" & 筛选列 & "”列无法排序！" End Sub ====================================分段====================================== 第三种情况：删除所有重复的记录1行都不要留，保留不重复的记录，代码如下： Sub 删除重复数据() '删除col列的重复数据 '本例是删除标题为sheet1的EXCEL表中A列（从A2单元格开始）的重复数据 Application.ScreenUpdating = False '可根据实际情况修改下面三行的结尾值 Dim sheetsCaption As String: sheetsCaption = "Sheet1" Dim Col As String: Col = "A" Dim StartRow As Integer: StartRow = 1 '以下不需要修改 Dim EndRow As Integer: EndRow = Sheets(sheetsCaption).Range(Col & "65536").End(xlUp).Row Dim Count_1 As Integer: Count_1 = 0 Dim j As Integer: j = 0 Dim i As Integer: i = StartRow With Sheets(sheetsCaption) Do j = i + 1 Count_1 = 0 Do If .Range(Col & i) = .Range(Col & j) Then Count_1 = 1 .Range(Col & j).EntireRow.Delete j = j - 1 EndRow = Sheets(sheetsCaption).Range(Col & "65536").End(xlUp).Row End If j = j + 1 Loop While j < EndRow + 1 If Count_1 = 1 Then .Range(Col & i).EntireRow.Delete EndRow = Sheets(sheetsCaption).Range(Col & "65536").End(xlUp).Row i = i - 1 End If i = i + 1 Loop While i < EndRow End With MsgBox "删除成功!" Application.ScreenUpdating = True End Sub 选中数据区，按“数据－筛选－高级筛选”，在出现的对话框中勾选“选择不重复数据”，并在上面选择“将筛选结果复制到其他位置”，然后在“复制到”中选择一个新位置，确定。这时所有数据只显示一个不重复的。