巧手提数，让Excel中数据不再重复

我们使用Excel处理数据，往往在使用过程中会在同一个表中出现若干个完全相同的数据（如下图1），怎么样去除重复的数据呢？

方法一：使用EXCEL的高级筛选功能

1.在菜单栏依次找到“数据→筛选→高级”，不同版本操作和显示可能不同，但顺序是一致的，弹出的提示对话框可以忽略直接确认即可（如图2，此处使用的是Excel 2013版）；

2.此时可以选择在原有区域显示结果，在“选择不重复记录”前面打√，确定即可，但这样得到的结果是在筛选模式，可能不方便后续操作，可以选择将“将筛选结果复制到其他位置”见图3；

3.一个确定，大功告成（见图4）。不要再去排序啊再删除啊，三五十条记录还可以，成百上千条，烦死人啊。

方法二：用VBA & SQL结合

这种方法复杂，感觉有点像脱了裤儿打屁。但对有些代码狂（像我），在Excel中用用SQL代码，感觉还是挺不错的，最后生成一个新的工作表，将不重复的数据复制到表中。（如图5所示）

代码粘贴如下，请高手指导。

'*********************************** 全局声明对象变量

Public Conn As Object

Public rs As Object

Public rsStation As Object

'*********************************** 定义数据链接

'SQL数据查询引擎子过程，适用于office2003以后的版本

Sub calladodb(Optional str_patch As String = "")

'如果参数str_patch为空的话，则用当前工作簿作为连接源

'如果参数str_patch非空则指定具体工作簿绝对路径

Dim str_excelver As String '用于保存excel的版本

Dim str_jet As String

Set Conn = CreateObject("ADODB.Connection")

Set rs = CreateObject("ADODB.Recordset")

'以下获取当前office的版本号

Select Case Val(Application.Version)

Case Is >= 12 'office2007及以上版本

str_excelvar = Right(ThisWorkbook.Name, 5)

str_jet = "Provider=Microsoft.Ace.OLEDB.12.0;" & "Extended Properties=Excel 12.0;Data Source="

Case Else 'office2003及以下版本

str_excelver = Right(ThisWorkbook.Name, 4)

str_jet = "Provider=Microsoft.Ace.OLEDB.4.0;" & "Extended Properties=Excel 8.0;Data Source="

End Select

'建立数据源进行会话连接

Conn.Open str_jet & IIf(Len(str_patch) > 0, str_patch, ThisWorkbook.FullName)

End Sub

Sub 提取不同()

'*****************************************

'此处使用在一个数据表中，按规定的字段（如班级）进行抽取数据建立新表为例,其步骤为：

'1.首先你要知道表中有哪些班级

'2.再根据班级循环提取数据

'3.如果表中存在数据的话，为了避免建立的表和原有表同时，先删除其他的非活动工作表

'4.新增一个工作表

'5.按提取字段重命名工作表

'6.将提取到的数据放到新增的工作表中

'*****************************************

'On Error GoTo Err '容错处理。若程序出现错误，友善系统提示

t = Timer '记时器，记录运行时间

Application.ScreenUpdating = False '关闭屏幕更新提示

Application.DisplayAlerts = False '关闭Excel系统提示，删除工作表时不会有安全提示

Dim str_sql As String '定义字符型变量用于保存相应的SQL查询代码

Dim sht As Worksheet '声明工作表对象

Dim o_sheet As Worksheet

Dim int_col As Long '定义长整型变量，用于数据列号

Dim str_StationName As String

Call calladodb

str_sql = "select distinct * from [原始数据$]"

Set rsStation = Conn.Execute(str_sql)

Sheets("不重复数据").Delete

Set o_sheet = ThisWorkbook.Worksheets.Add

With o_sheet

.Name = "不重复数据"

For int_col = 1 To rsStation.Fields.Count

.Cells(1, int_col) = rsStation.Fields(int_col - 1).Name

Next int_col

.Range("A2").CopyFromRecordset rsStation

.Cells.EntireColumn.AutoFit

End With

rsStation.Close '关闭本次查询结果集

Conn.Close '关闭数据源连接

If Not rsStation Is Nothing Then Set rsStation = Nothing

If Not rs Is Nothing Then Set Conn = Nothing

If Not Conn Is Nothing Then Set Conn = Nothing

MsgBox "已完成数据拆分处理，共用时:" & Format(Round((Timer - t) / 1000, 5), "0.00000") & "秒"

Application.DisplayAlerts = True '恢复系统提示

End Sub