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