EXCEL实用VBA自动进行数据去重

2025-10-25 15:21:52

1、零、先开启EXCEL的宏功能。

EXCEL实用VBA自动进行数据去重

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

EXCEL实用VBA自动进行数据去重

3、二、绘制按钮

EXCEL实用VBA自动进行数据去重

EXCEL实用VBA自动进行数据去重

EXCEL实用VBA自动进行数据去重

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

EXCEL实用VBA自动进行数据去重

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、单击“数据去重”按钮,按提示操作

EXCEL实用VBA自动进行数据去重

EXCEL实用VBA自动进行数据去重

2、是否确认去重

EXCEL实用VBA自动进行数据去重

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

EXCEL实用VBA自动进行数据去重

4、设置去重列 A列

5、起始行 默认第1行

6、总行数,默认100行

EXCEL实用VBA自动进行数据去重

EXCEL实用VBA自动进行数据去重

EXCEL实用VBA自动进行数据去重

EXCEL实用VBA自动进行数据去重

EXCEL实用VBA自动进行数据去重

EXCEL实用VBA自动进行数据去重

声明:本网站引用、摘录或转载内容仅供网站访问者交流或参考,不代表本站立场,如存在版权或非法内容,请联系站长删除,联系邮箱:site.kefu@qq.com。
猜你喜欢