'---------------------------------------------------------------
'   功能：对指定列进行查重，并标红或删除重复行
'   作者：dnawo
'   web：http://www.mzwu.com/
'   时间：2009-03-02
'---------------------------------------------------------------
Option Explicit
Sub 查重()
    Dim columns As String     '要查重的列
    Dim columnsList() As String '要查重的列数组
    Dim delrows As String    '要删除的行,格式: |10|11|14|20|
    Dim delrowsList() As String '要删除的行数组
    Dim isDouble As Boolean
    Dim i, j, k As Integer
    
    
    columns = InputBox("请输入要查重的列数(第一列为1,第二列为2)，如1,2,3", "列数：", "1")
    delrows = "|"
    
    If columns <> "" Then
        columnsList = Split(columns, ",")
    
        '列格式验证
        For i = 0 To UBound(columnsList)
            If Not IsNumeric(columnsList(i)) Then
                MsgBox "列数应为数字！错误的列数：" & columnsList(i), vbOKOnly, "出错："
                Exit Sub
            End If
        Next

        '判断并获取重复的行索引
        For i = 1 To ActiveSheet.UsedRange.Rows.count
            '已判定重复的行不再次进行判断,下同
            If InStr(delrows, "|" & CStr(i) & "|") = 0 Then
                For j = i + 1 To ActiveSheet.UsedRange.Rows.count
                    If InStr(delrows, "|" & CStr(j) & "|") = 0 Then
                        '查重
                        isDouble = True
                        For k = 0 To UBound(columnsList)
                            If Cells(i, CInt(columnsList(k))) <> Cells(j, CInt(columnsList(k))) Then
                                isDouble = False
                                Exit For
                            End If
                        Next
                        
                        '记录重复行
                        If isDouble Then
                            delrows = delrows & CStr(j) & "|"
                        End If
                    End If
                Next
            End If
        Next
        
        '处理重复行
        If delrows <> "|" Then
            delrowsList = Split(Mid(delrows, 2, Len(delrows) - 2), "|")
          
            'delrowsList从大到小排序方便下边删除重复行
            Dim tmp As String
            For i = 0 To UBound(delrowsList)
                For j = i + 1 To UBound(delrowsList)
                    If CInt(delrowsList(i)) < CInt(delrowsList(j)) Then
                        tmp = delrowsList(i)
                        delrowsList(i) = delrowsList(j)
                        delrowsList(j) = tmp
                    End If
                Next
            Next
            
            '重复行处理:标红或删除
            For i = 0 To UBound(delrowsList)
                Cells.Rows(CInt(delrowsList(i))).Font.Color = vbRed    '标红
                'Cells.Rows(CInt(delrowsList(i))).Delete    '删除
            Next
        End If
        
         MsgBox "查重结束！", vbOKOnly, "提示："
    Else
        MsgBox "没有输入要查重的列数！", vbOKOnly, "出错："
    End If
End Sub