vba 删除查询queries 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 + 1If 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