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