第一種情況保留不重複的記錄行，重複的只保留一行。
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