EXCEL中避免同一列及相邻列中出现重复数据[原创]

宏代码如下：

Private Sub Worksheet_SelectionChange(ByVal Target As Range) '检测相邻两列时，先检测右边再检测左边
    Dim RC
    Dim RCR As String
    Dim i As Long
    RCR = ""
    If Split(ActiveCell.Address, "$")(2) = "1" Then Exit Sub '选中第一行时不执行本SUB
    '检查同一行是否有相同数据（左右相邻的两个单元格）
    Select Case Split(ActiveCell.Address, "$")(1)
        Case "A"
            If Range("B" & Split(ActiveCell.Address, "$")(2) - 1).Value = Range("A" & Split(ActiveCell.Address, "$")(2) - 1).Value And Range("A" & (Split(ActiveCell.Address, "$")(2)) - 1).Value <> "" Then
                Range("B" & Split(ActiveCell.Address, "$")(2) - 1).Interior.Color = RGB(200, 160, 35)
                Range("A" & Split(ActiveCell.Address, "$")(2) - 1).Interior.Color = vbRed
                RC = MsgBox("IMEI号：" & Range("A" & Split(ActiveCell.Address, "$")(2) - 1).Value & "与单元格" & Range("B" & Split(ActiveCell.Address, "$")(2) - 1) & "的IMEI号重复！是否处理？", vbYesNo + vbQuestion, "号码重复！是否处理？      ------Powered By 游虫")
                If RC = vbYes Then
                    Range("B" & Split(ActiveCell.Address, "$")(2) - 1).Interior.ColorIndex = False
                    Range("A" & Split(ActiveCell.Address, "$")(2) - 1).Interior.ColorIndex = False
                    Range("A" & Split(ActiveCell.Address, "$")(2) - 1).Value = ""
                    Range("A" & Split(ActiveCell.Address, "$")(2) - 1).Select
                    Exit Sub
                End If
            End If
        Case "Z"
            If Range("Y" & Split(ActiveCell.Address, "$")(2) - 1).Value = Range("Z" & Split(ActiveCell.Address, "$")(2) - 1).Value And Range("Z" & (Split(ActiveCell.Address, "$")(2)) - 1).Value <> "" Then
                Range("Y" & Split(ActiveCell.Address, "$")(2) - 1).Interior.Color = RGB(200, 160, 35)
                Range("Z" & Split(ActiveCell.Address, "$")(2) - 1).Interior.Color = vbRed
                RC = MsgBox("IMEI号：" & Range("Z" & Split(ActiveCell.Address, "$")(2) - 1).Value & "与单元格" & Range("Y" & Split(ActiveCell.Address, "$")(2) - 1) & "的IMEI号重复！是否处理？", vbYesNo + vbQuestion, "号码重复！是否处理？      ------Powered By 游虫")
                If RC = vbYes Then
                    Range("Y" & Split(ActiveCell.Address, "$")(2) - 1).Interior.ColorIndex = False
                    Range("Z" & Split(ActiveCell.Address, "$")(2) - 1).Interior.ColorIndex = False
                    Range("Z" & Split(ActiveCell.Address, "$")(2) - 1).Value = ""
                    Range("Z" & Split(ActiveCell.Address, "$")(2) - 1).Select
                    Exit Sub
                End If
            End If
        Case Else
            If ActiveCell.Column > 26 Then Exit Sub '最大为Z列(Z的ASCII码为128)，超出范围则不处理
            If Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & Split(ActiveCell.Address, "$")(2) - 1).Value = Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value And Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value <> "" Then
                Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & Split(ActiveCell.Address, "$")(2) - 1).Interior.Color = RGB(200, 160, 35)
                Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.Color = vbRed
                RC = MsgBox("IMEI号：" & Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value & "与单元格" & Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & Split(ActiveCell.Address, "$")(2) - 1 & "的IMEI号重复！是否处理？", vbYesNo + vbQuestion, "号码重复！是否处理？      ------Powered By 游虫")
                If RC = vbYes Then
                    Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & Split(ActiveCell.Address, "$")(2) - 1).Interior.ColorIndex = False
                    Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.ColorIndex = False
                    Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value = ""
                    RCR = CStr(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1)
                End If
            End If
            If Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & Split(ActiveCell.Address, "$")(2) - 1).Value = Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value And Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value <> "" Then
                Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & Split(ActiveCell.Address, "$")(2) - 1).Interior.Color = RGB(200, 160, 35)
                Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.Color = vbRed
                RC = MsgBox("IMEI号：" & Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value & "与单元格" & Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & Split(ActiveCell.Address, "$")(2) - 1 & "的IMEI号重复！是否处理？", vbYesNo + vbQuestion, "号码重复！是否处理？      ------Powered By 游虫")
                If RC = vbYes Then
                    Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & Split(ActiveCell.Address, "$")(2) - 1).Interior.ColorIndex = False
                    Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.ColorIndex = False
                    Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value = ""
                    RCR = CStr(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1)
                End If
            End If
            If RCR <> "" Then Range(RCR).Select: RCR = "": Exit Sub
    End Select
    If Split(ActiveCell.Address, "$")(2) = 1 Then Exit Sub  '活动单元格是最顶上的单元格时退出SUB
    For i = 1 To (Split(ActiveCell.Address, "$")(2) - 2)
        '检查同一列是否有相同的数据
        If Range(Split(ActiveCell.Address, "$")(1) & i).Value = Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value And Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value <> "" Then
            Range(Split(ActiveCell.Address, "$")(1) & i).Interior.Color = RGB(200, 160, 35)
            Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.Color = vbRed
            RC = MsgBox("IMEI号：" & Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value & "与单元格" & Split(ActiveCell.Address, "$")(1) & i & "的IMEI号重复！是否处理？", vbYesNo + vbQuestion, "号码重复！是否处理？      ------Powered By 游虫")
            If RC = vbYes Then
                Range(Split(ActiveCell.Address, "$")(1) & i).Interior.ColorIndex = False
                Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.ColorIndex = False
                Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value = ""
                Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Select
                Exit Sub
            End If
        End If
        '检查相邻列是否存在相同数据（相同行之前的行）
        Select Case Asc(Split(ActiveCell.Address, "$")(1))
            Case Asc("A") '输入A列时
                If Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & i).Value = Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value And Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value <> "" Then
                    Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & i).Interior.Color = RGB(200, 160, 35)
                    Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.Color = vbRed
                    RC = MsgBox("IMEI号：" & Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value & "与单元格" & Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & i & "的IMEI号重复！是否处理？", vbYesNo + vbQuestion, "号码重复！是否处理？      ------Powered By 游虫")
                    If RC = vbYes Then
                        Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & i).Interior.ColorIndex = False
                        Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.ColorIndex = False
                        Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value = ""
                        Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Select
                        Exit Sub
                    End If
                End If
            Case Asc("Z") '输入Z列时
                If Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & i).Value = Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value And Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value <> "" Then
                    Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & i).Interior.Color = RGB(200, 160, 35)
                    Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.Color = vbRed
                    RC = MsgBox("IMEI号：" & Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value & "与单元格" & Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & i & "的IMEI号重复！是否处理？", vbYesNo + vbQuestion, "号码重复！是否处理？      ------Powered By 游虫")
                    If RC = vbYes Then
                        Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & i).Interior.ColorIndex = False
                        Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.ColorIndex = False
                        Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value = ""
                        Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Select
                        Exit Sub
                    End If
                End If
            Case Else 'A-Z中间区段
                If ActiveCell.Column > 26 Then Exit Sub '最大为Z列(Z的ASCII码为128)，超出范围则不处理
                If Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & i).Value = Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value And Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value <> "" Then
                    Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & i).Interior.Color = RGB(200, 160, 35)
                    Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.Color = vbRed
                    RC = MsgBox("IMEI号：" & Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value & "与单元格" & Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & i & "的IMEI号重复！是否处理？", vbYesNo + vbQuestion, "号码重复！是否处理？      ------Powered By 游虫")
                    If RC = vbYes Then
                        Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) + 1) & i).Interior.ColorIndex = False
                        Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.ColorIndex = False
                        Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value = ""
                        RCR = CStr(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1)
                    End If
                End If
                If Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & i).Value = Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value And Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value <> "" Then
                    Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & i).Interior.Color = RGB(200, 160, 35)
                    Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.Color = vbRed
                    RC = MsgBox("IMEI号：" & Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value & "与单元格" & Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & i & "的IMEI号重复！是否处理？", vbYesNo + vbQuestion, "号码重复！是否处理？      ------Powered By 游虫")
                    If RC = vbYes Then
                        Range(Chr(Asc(Split(ActiveCell.Address, "$")(1)) - 1) & i).Interior.ColorIndex = False
                        Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Interior.ColorIndex = False
                        Range(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1).Value = ""
                        RCR = CStr(Split(ActiveCell.Address, "$")(1) & (Split(ActiveCell.Address, "$")(2)) - 1)
                    End If
                End If
                If RCR <> "" Then Range(RCR).Select: RCR = "": Exit Sub
        End Select
    Next i
End Sub