帮黄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