VBA处理单元格内容比较

帮宏哥写的宏代码，因为顺丰每个月的对账单都不一样，所以单独提取出来进行处理。

'放入工作表
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