关闭

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

标签: excelvbaintegerstringheadervb
2387人阅读 评论(0) 收藏 举报
 
请仔细阅读并修改相关数据。我推荐使用第二种方法,是我修改的,很好用,第三种情况用得比较少。 
第一种情况保留不重复的记录行,重复的只保留一行。

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

0
0

查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:71870次
    • 积分:826
    • 等级:
    • 排名:千里之外
    • 原创:7篇
    • 转载:11篇
    • 译文:0篇
    • 评论:7条
    最新评论