office-excel_vba查找数据

帮黄XX写的一个自动标亮单元格的vba语句。用于查找快递单号后4位，如果找到唯一就自动标亮单元格，便于对账使用。为了方便同事修改，对每一句都加了注释。

工作表事件

'以下内容放入需要按下回车就执行宏的表格里面
Private Sub worksheet_selectionchange(ByVal target As Range)    '工作表选择事件
Application.OnKey "{enter}", "kaishi"                           '按下回车执行kaishi模块
Application.OnKey "~", "kaishi"                                 '按下小键盘回车执行kaishi模块
End Sub                                                         '结束语句

vba宏代码

'以下内容放入模块中
Public kg, kddh, srdh, djck, czws, czw, sjl, ksh  '(定义全局变量，开关kg，快递单号kddh，输入单号srdh，冻结窗口djck，查找位数表头czws，查找位czw，数据列sjl，数据开始行ksh
Sub kaishi()
    If Range("A1") = "YUNDA" Then '如果A1单元格是YUNDA，那么执行下面的语句
        kg = "G1" '变量kg的位置在G1
        kddh = "H1" '变量kddh（快递单号的表头）输入在H1单元格
        srdh = "I1" '变量srdh的位置在I1
        czws = "J1" '变量czws的位置在J1
 czw = "K1" '变量czw的位置在K1
        djck = 4 '变量djck的位置在第四行（4行之前的固定不动）
        sjl = 2 '变量sjl等于2（快递单号存放的列号）
        ksh = 5 '变量ksh等于5（快递单号从第几行开始的
      Else '如果A1单元格不是YUNDA，那就是顺丰，执行下面的语句
        kg = "AA1" '变量kg的位置在AA1
        kddh = "AB1" '变量kddh（快递单号的表头）输入在AB1单元格
        srdh = "AC1" '变量srdh的位置在AC1
        czws = "AD1" '变量czws的位置在AD1
        czw = "AE1" '变量czw的位置在AE1
        djck = 10 '变量djck的位置在第10行（10行之前的固定不动）
        sjl = 3 '变量sjl等于2（快递单号存放的列号）
        ksh = 11 '变量ksh等于5（快递单号从第几行开始的
    End If '结束是韵达还是顺丰的判断
    If Range(kg) = "" Then '如果变量开关的位置没有内容，那么执行以下语句
        Range(kg) = 0 '变量开关等于0
        Range(czw) = 4 '定义查找位是快递单号的后四位
        Range(kddh) = "单号后几位" '输入提示表头
        Range(srdh) = 8888 '快递单号输入表格的初始值
        Range(czws) = "查找位数" '查找位数提示的表头
        Range(srdh).Interior.ColorIndex = 39 '设置输入表格的背景色
        ActiveWindow.SplitRow = djck '根据变量djck设置冻结窗口的位置
        ActiveWindow.FreezePanes = True '确定冻结窗口为真
      ElseIf Range(kg) = 1 Then '如果开关不等于空，但等于1那么执行下面语句
        Call chazhao '执行chazhao模块
      Else '如果开关不等于空，也不等于1，执行下面语句
        Call kaiguan '执行kaiguan模块
    End If '结束开关的判断
End Sub '结束kaishi模块
Sub kaiguan() '定义kaiguan模块
    Range(kg) = 1 '开关等于1
    Range(srdh).Activate '活动单元格激活到输入单号的位置
End Sub '结束kaiguan模块
Sub chazhao() '定义chazhao模块
    Dim b, c '定义变量b，c
    b = 0 '变量b初始为0
    For i = ksh To Cells(65536, sjl).End(xlUp).Row '循环变量i等于开始行到数据列的最后一个非空单元格
       If Right(Cells(i, sjl), Range(czw).Value) * 1 = Range(srdh) * 1 Then '如果cells(行i,列sjl)的值等于输入单号，那么执行下面的语句
            b = b + 1 '变量b+1
            c = Cells(i, sjl).Address '变量c等于查找到相等单元格的地址
       End If '结束是查找值与数据列是否相等的判断
    Next i '继续i+1并再次执行for下面的语句，直到i的最大值
    If b = 0 Then '如果变量b等于0
        MsgBox "没有找到数据。" '弹出窗口没有找到数据
        Range(kg) = 1 '开关等于1
        Range(srdh).Activate '激活到输入单号的位置
      ElseIf b = 1 Then '如果b不等于0，但等于1
        Range(c).Select '选择变量c的位置
        ActiveCell.Interior.ColorIndex = 40 '对当前活动单元格的背景色设置
        Range(kg) = 0 '开关等于0
      ElseIf b > 1 Then '如果b不等于0，也不等于1，但大于1那么，弹出下面的窗口
        MsgBox "共有" & b & "个重复数据，请更改查找位数再尝试。"
        Range(czw).Activate '激活单元格位置到查找位
    End If '结束变量b的判断
End Sub '结束chazhao模块

更新：

Sub kaishi()
'初始查找表头条件
If Range("O1") <> "开关" Then
    Range("O1") = "开关"
    Range("O2") = "单号开始行"
    Range("O3") = "单号结束行"
    Range("O4") = "单号所在列"
    Range("O4") = "查找位数"
    Range("P4") = 4
    Range("O5") = "查找单号"
    Range("P5") = 8888
    Range("P5").Interior.ColorIndex = 39
    
    For H = 1 To 30 '获取数据区域位置
     If Cells(H, 1) = "序号" Then
         Range("P2") = H + 1
         Exit For
     End If
    Next H
    Range("P3") = Cells(Range("P2").Value, 3).End(xlDown).Row
    
End If
If Range("P1") = "" Then
    Range("P1") = 0
    ActiveWindow.SplitRow = Range("P2") - 1
    ActiveWindow.FreezePanes = True
  ElseIf Range("P1") = 1 Then
    Call chazhao
  Else
    Call kaiguan
End If
End Sub
Sub kaiguan()
    Range("P1") = 1
    Range("P5").Activate
End Sub
Sub chazhao()
    Dim b, c
    b = 0
    For i = Range("P2") To Range("P3")
       If Right(Cells(i, 3), Range("P4").Value) * 1 = Range("P5") * 1 Then
            b = b + 1
            c = Cells(i, 3).Address
       End If
    Next i
    If b = 0 Then
        MsgBox "没有找到数据。"
        Range("P1") = 1
        Range("P5").Activate
      ElseIf b = 1 Then
        Range(c).Select
        ActiveCell.Interior.ColorIndex = 40
        Range("P1") = 0
      ElseIf b > 1 Then
        MsgBox "共有" & b & "个重复数据，请更改查找位数再尝试。"
        Range("P4").Activate
    End If
End Sub