幫宏哥寫的宏代碼，因?yàn)轫権S每個(gè)月的對(duì)賬單都不一樣，所以單獨(dú)提取出來(lái)進(jìn)行處理。

'放入工作表
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
        '初次運(yùn)行調(diào)用表格處理并賦值A(chǔ)1等于順豐
        Call 表格處理
        Range("A1") = "順豐"
        '表頭處理
        kddh = "Q1"
        Range(kddh) = "單號(hào)后幾位"
        '設(shè)置單號(hào)輸入單元格初始值及背景色
        srdh = "R1"
        Range(srdh) = 8888
        Range(srdh).Interior.ColorIndex = 39
        '表頭處理
        czws = "S1"
        Range(czws) = "查找位數(shù)"
        '設(shè)置查找匹配位數(shù)
        czw = "T1"
        Range(czw) = 4
        '凍結(jié)窗口
        djck = 17
        ActiveWindow.SplitRow = djck
        ActiveWindow.FreezePanes = True
        '單號(hào)所在數(shù)據(jù)列號(hào)以及單號(hào)開始行號(hào)
        sjl = 3
        ksh = djck + 1
    End If
    '開關(guān)位置判斷
    If kg = 1 Then
        Call chazhao
      Else
        Call kaiguan
    End If
End Sub
Sub kaiguan()
    '開關(guān)還原，定位到輸入單號(hào)的單元格以備輸入
    kg = 1
    Range(srdh).Activate
End Sub
Sub chazhao()
    Dim b, c
    b = 0
    '用數(shù)據(jù)列的后4位與輸入單號(hào)進(jìn)行判斷
    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
    '對(duì)判斷結(jié)果進(jìn)行處理
    If b = 0 Then
        MsgBox "沒(méi)有找到數(shù)據(jù)。"
        kg = 1
        Range(srdh).Activate
    ElseIf b = 1 Then
        Range(c).Select
        ActiveCell.Interior.ColorIndex = 40
        kg = 0
    ElseIf b > 1 Then
        MsgBox "共有" & b & "個(gè)重復(fù)數(shù)據(jù)，請(qǐng)更改查找位數(shù)再嘗試。"
        Range(czw).Activate
    End If
End Sub
Sub 表格處理()
    '獲取工作表名
    oldname = ActiveSheet.Name
    Sheets.Add
    newname = ActiveSheet.Name
    '復(fù)制舊表到新表，粘貼屬性為：值
    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
    '設(shè)置運(yùn)單號(hào)列寬
    Columns("C:C").EntireColumn.AutoFit
End Sub