Excel中的VBA宏：对指定数据列判重

最近遇到一个要对Excel内指定列内容判重的问题，指定的列能够是一列也能够是多列，因为肉眼判重效率低下且准确性很低，因此我写了一些VBA宏来解决这一问题。我使用的Office为 Microsoft Office Professional Plus 2010，我使用的Excel 版本为14.0.4760.1000（32位）。

我实现的例程（Sub）共有三个

1）GetRepeat：暴力查重，很是不推荐

2）GetRepeatSorted：查重排序后的数据，数据量大时速度比1快不少，推荐

3）SortData：按指定列进行排序

文件【Excel判重函数.bas】中代码以下：

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Excel判重比较用宏
' 做者：Tsybius2014
' 时间：2016年1月2日13:02:40
'
' 描述：Excel判重比较用宏，检查基础数据中重复项时使用
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Attribute VB_Name = "Excel判重函数模块"

'两列数据判重（暴力，不推荐） - 例：数据字典判重
Sub GetRepeat()

    Dim SheetName As String
    SheetName = "数据字典子表"

    Dim Column1, Column2 As String
    Column1 = "B" '被比较列1
    Column2 = "C" '被比较列2
    
    Dim Start As Integer
    Dim Limit As Integer
    Start = 3 '比较行起始点
    Limit = 873 '比较行截止点
    
    Dim Result As String
    For i = Start To Limit
        For j = i + 1 To Limit
            If Range(Column1 & i).Text = "" Or Range(Column2 & i).Text = "" Then
                'Do Nothing
            ElseIf Range(Column1 & i).Text = Range(Column1 & j).Text And _
                Range(Column2 & i).Text = Range(Column2 & j).Text Then
                Result = Result & "发现重复行：" & i & " - " & j & vbCrLf
            End If
        Next
    Next
    If Not Result = "" Then
        MsgBox "找到重复项" & vbCrLf & Result
    Else
        MsgBox "未找到重复项"
    End If

End Sub

'两列数据判重（排序后使用，推荐） - 例：数据字典判重
Sub GetRepeatSorted()

    Dim SheetName As String
    SheetName = "数据字典子表"

    Dim Column1, Column2 As String
    Column1 = "B" '被比较列1
    Column2 = "C" '被比较列2
    
    Dim Start As Integer
    Dim Limit As Integer
    Start = 3  '比较行起始点
    Limit = 873 '比较行截止点
    
    Dim Result As String
    For i = Start To Limit - 1
        If Range(Column1 & i).Text = "" Or Range(Column2 & i).Text = "" Then
            'Do Nothing
        ElseIf Range(Column1 & i).Text = Range(Column1 & (i + 1)).Text And _
            Range(Column2 & i).Text = Range(Column2 & (i + 1)).Text Then
            Result = Result & "发现重复行：" & i & " - " & (i + 1) & vbCrLf
        End If
    Next
    If Not Result = "" Then
        MsgBox "找到重复项" & vbCrLf & Result
    Else
        MsgBox "未找到重复项"
    End If

End Sub

'两列自动排序 - 例：数据字典排序
Sub SortData()

    Dim SheetName As String
    SheetName = "数据字典子表"
    
    Dim Column1Range As String
    Dim Column2Range As String
    Dim SortRange As String
    Column1Range = "B3:B873" '用于排序的范围1
    Column2Range = "C3:C873" '用于排序的范围2
    SortRange = "B2:K873"    '排序影响的范围

    ActiveWorkbook.Worksheets(SheetName).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(SheetName).Sort.SortFields.Add Key:=Range(Column1Range) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    ActiveWorkbook.Worksheets(SheetName).Sort.SortFields.Add Key:=Range(Column2Range) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(SheetName).Sort
        .SetRange Range(SortRange)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub

将这个bas文件导入到Excel内置的VB编辑器中，就能够在菜单【视图】→【宏】→【查看宏】打开宏管理界面并使用了。

以下图是对某Excel文档进行的判重，该文档记录了一个数据字典的对照关系，要求每两个数据字典条目中的条目编号和数据字典的子项编号不能所有一致。在对该文档查重时，我先执行了例程SortData，对字典条目代码和字典子项进行排序，再执行GetRepeatSorted函数，就能够很快地找到重复的行了。

使用这个宏前要注意：

一、使用前，要先将宏中每一个函数前面的赋值部分（如被比较的Sheet页名、被比较列、被比较范围等）改为适应当前Excel文档的状态。

二、上面代码都是以两列中内容不能所有一致的逻辑写的，如要实现单列、三列或更多列，对宏进行简单修改后便可实现。

END