Excel中删除重复数据(用VBA代码)

转载 2012年03月21日 12:52:10
 
请仔细阅读并修改相关数据。我推荐使用第二种方法,是我修改的,很好用,第三种情况用得比较少。 
第一种情况保留不重复的记录行,重复的只保留一行。

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

相关文章推荐

Excel.VBA 快速删除重复记录

Excel.VBA 快速删除重复记录 日常工作中的工作表中经常会有重复记录,清除这些重复记录是一个繁琐的工作,即使在排序之后再进行手工筛选,也经常会出现遗漏,而使用VBA代码就可以快速准确地删除...
  • yihui8
  • yihui8
  • 2012年12月07日 16:28
  • 4193

EXCEL中如何根据某列找到重复的行,并将重复只保留一条其余的删除?

用宏处理这样的问题相对方便一点,有兴趣试试: 一、按ALT+F11 打开VB编辑器 二、双击左边靠上的【工程资源管理器】中的【MS Excel 对象】中的ThisWorkbook,在右边的代码窗口贴入...
  • JimFire
  • JimFire
  • 2008年09月06日 21:21
  • 4835

使用VBA,20行代码 将Excel数据导出

程序员免不了与策划或运维打交道。通常情况是有配置数据的更改。但是即便是程序员也有写错的时候。更改一个配置,使用更直观的excel,成为了单写配置工具的替代方案。这里介绍一个将Excel的数据导出生成文...

向IE导入EXCEL数据的VBA代码

  • 2016年01月08日 19:34
  • 1KB
  • 下载

excel中删除重复数据

  • 2009年02月20日 15:48
  • 1KB
  • 下载

Excel VBA 代碼

Dim not_done As Integer Private Sub Worksheet_Activate() 'MsgBox ("oo") not_done = 0 For c...

EXCEL VBA常用代码集

1.显示活动工作簿名称 MsgBox "当前活动工作簿是 " & ActiveWorkbook.Name 2.保存活动工作簿 Activeworkbook.Save 3.保存所有打开...

Excel 2010 中发生事件时运行 VBA 代码

Excel 2010 中发生事件时运行 VBA 代码 Office 2010              1(共 1)对本文的评价是有帮助 - 评价此主题              ...
  • superes
  • superes
  • 2013年05月31日 17:24
  • 1296

Excel VBA 代码笔记

欢迎使用Markdown编辑器写博客本Markdown编辑器使用StackEdit修改而来,用它写博客,将会带来全新的体验哦: Markdown和扩展Markdown简洁的语法 代码块高亮 图片链接和...

用Excel VBA代码实现去重录入某字段内容

通过自定义窗体录入信息,用Excel VBA代码实现去重验证。文末对用到的主要知识点进行了梳理。...
  • frgod
  • frgod
  • 2016年12月02日 00:06
  • 525
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:Excel中删除重复数据(用VBA代码)
举报原因:
原因补充:

(最多只允许输入30个字)