帮宏哥写的宏代码,因为顺丰每个月的对账单都不一样,所以单独提取出来进行处理。
'放入工作表
Private Sub worksheet_selectionchange(ByVal target As Range)
Application.OnKey "{enter}", "kaishi"
Application.OnKey "~", "kaishi"
End Sub
'放入模块
Public kg, kddh, srdh, djck, czws, czw, sjl, ksh
Sub kaishi()
If Range("A1") <> "顺丰" Then
'初次运行调用表格处理并赋值A1等于顺丰
Call 表格处理
Range("A1") = "顺丰"
'表头处理
kddh = "Q1"
Range(kddh) = "单号后几位"
'设置单号输入单元格初始值及背景色
srdh = "R1"
Range(srdh) = 8888
Range(srdh).Interior.ColorIndex = 39
'表头处理
czws = "S1"
Range(czws) = "查找位数"
'设置查找匹配位数
czw = "T1"
Range(czw) = 4
'冻结窗口
djck = 17
ActiveWindow.SplitRow = djck
ActiveWindow.FreezePanes = True
'单号所在数据列号以及单号开始行号
sjl = 3
ksh = djck + 1
End If
'开关位置判断
If kg = 1 Then
Call chazhao
Else
Call kaiguan
End If
End Sub
Sub kaiguan()
'开关还原,定位到输入单号的单元格以备输入
kg = 1
Range(srdh).Activate
End Sub
Sub chazhao()
Dim b, c
b = 0
'用数据列的后4位与输入单号进行判断
For i = ksh To Cells(65536, sjl).End(xlUp).Row
If Right(Cells(i, sjl), Range(czw).Value) * 1 = Range(srdh) * 1 Then
b = b + 1
c = Cells(i, sjl).Address
End If
Next i
'对判断结果进行处理
If b = 0 Then
MsgBox "没有找到数据。"
kg = 1
Range(srdh).Activate
ElseIf b = 1 Then
Range(c).Select
ActiveCell.Interior.ColorIndex = 40
kg = 0
ElseIf b > 1 Then
MsgBox "共有" & b & "个重复数据,请更改查找位数再尝试。"
Range(czw).Activate
End If
End Sub
Sub 表格处理()
'获取工作表名
oldname = ActiveSheet.Name
Sheets.Add
newname = ActiveSheet.Name
'复制旧表到新表,粘贴属性为:值
Sheets(oldname).Select
Cells.Select
Selection.Copy
Sheets(newname).Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'删除空列
Del_Col:
For i = 1 To Cells(17, 255).End(xlToLeft).Column
If Cells(17, i) = "" Then
Columns(i).Delete
GoTo Del_Col:
End If
Next i
'设置运单号列宽
Columns("C:C").EntireColumn.AutoFit
End Sub