mic86

宏代码如下:

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

 

分类:

技术点:

相关文章:

  • 2021-06-01
  • 2021-04-09
  • 2021-11-28
  • 2021-06-03
  • 2022-01-03
  • 2021-11-08
  • 2021-12-03
猜你喜欢
  • 2021-11-02
  • 2021-11-22
  • 2022-02-07
  • 2021-12-12
  • 2021-05-07
  • 2021-11-27
相关资源
相似解决方案