EXCEL实用VBA自动进行数据去重
1、零、先开启EXCEL的宏功能。

2、一、开发工具,单击设计模式

3、二、绘制按钮



4、三、删除原来所有代码;将本文档最后的代码复制到代码窗口—保存文档即可

5、‘源代码:
Public Sub Quchong()
'删除重复数据_必须对对数据行进行排序,否则无法去重干净
'删除col列的重复数据
'本例是删除标题为sheet1的EXCEL表中A列(从A2单元格开始)的重复数据
'qq:973490770
'Application.ScreenUpdating = False
'---------------------------------------
'可根据实际情况修改下面三行的结尾值
Dim sheetsCaption As String: sheetsCaption = ActiveSheet.Name
Dim Col As String '确定哪一列
Dim StartRow As Long '确定开始行,必须大于等于1
Dim myRow As Long '确定总行数
'----------------------------------------
'以下不需要修改
'Dim EndRow As Long: EndRow = Sheets(sheetsCaption).Range(Col & "65536").End(xlUp).Row
Dim Count_1 As Long: Count_1 = 0
Dim Count_2 As Long: Count_2 = 0
Dim N, i As Long: i = StartRow: N = 0
Dim Str_i As String, ifDel%, flag_1 As Boolean
Application.ScreenUpdating = True
MsgBox "必须提前对" & Col & "列进行升或者降序排序,否则无法将重复项去除干净。准备去除" & StartRow & "到" & myRow & "之间的重复数据行"
ifDel = MsgBox("去重的数据列必须进行排序,否则可能有遗漏的重复项;是否确认继续去重,“是”继续,“否”退出", vbYesNo)
If ifDel = 6 Then
Col = "A"
StartRow = 1
myRow = 100
Col = InputBox("请输入要去重的那一列的列号,例如A\B\C\D等等", , "A")
StartRow = InputBox("请输入开始行的行号,例如1、2、3...1000等等,必须大于等于1的整数", , "1")
myRow = InputBox("请输入查重所在列的数据总行数,例如5000,必须是正整数", , "100")
i = StartRow
ifDel = 0
ifDel = MsgBox("是否删除重复行", vbYesNo)
If ifDel = 6 Then
flag_1 = True
Else
flag_1 = False
End If
With Sheets(sheetsCaption)
Str_i = .Range(Col & i).Value
Do
N = N + 1
.Range(Col & i).Select
If .Range(Col & i + 1) = Str_i Then
If flag_1 = True Then
.Range(Col & i + 1).EntireRow.Delete
'删除整行的话,i不用加1
Else
.Range(Col & i + 1).Value = ""
i = i + 1
'比较下一个
End If
Count_2 = Count_2 + 1
'计数重复数据
Else
Str_i = .Range(Col & i + 1).Value
i = i + 1
Count_1 = Count_1 + 1
'记录不重复数据
End If
Loop While N < myRow
End With
MsgBox "留下" & Count_1 & "条不重复的数据"
MsgBox "已经删除" & Count_2 & "条重复的数据啦亲!么么哒!!"
Application.ScreenUpdating = True
End If
End Sub
Private Sub CommandButton1_Click()
Quchong
End Sub
1、单击“数据去重”按钮,按提示操作


2、是否确认去重

3、是否删除重复数据的整行,还是删除这个单元格

4、设置去重列 A列
5、起始行 默认第1行
6、总行数,默认100行





