Excel中重複資料刪除資料(用VBA代碼)

 

請仔細閱讀並修改相關資料。我推薦使用第二種方法，是我修改的，很好用，第三種情況用得比較少。 
第一種情況保留不重複的記錄行，重複的只保留一行。
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