每月制作工資表導出為Excel后都需要調整格式，刪除0數據的列、對工資表項目進行排序、打印設置等等，有些單位還分有“行政”、“事業”2個工資表就需要操作2次。顯然，這種重復操作的問題，可以使用VBA代碼解決

代碼使用說明

• 代碼作用范圍：以下代碼作用于活動工作簿/工作表，無需將待處理的工資表保存在啟用宏的工作簿中（xlsm格式），只要待處理的工資表處于活動狀態即可運行代碼。同時，也不建議把數據保存在xlsm文件中，vba代碼運行結果是無法撤銷的
  活動工作簿：如果打開多個工作簿，顯示在最前面的就是活動工作簿
  活動工作表：活動工作簿當前顯示的工作表

1，工資表格式處理

涉及功能

• 數據調整：工資表各項目按指定順序排序，添加合計數行，刪除合計數為0的列，刪除無意義項目列（應發合計、扣款合計），添加工資表所屬月份，添加個稅所屬月份，添加制表人及時間
  參數bt可指定工資表各項目的順序，如果工資表中存在某項不在參數bt內，且合計數不為0的，則該列排序在最后一列
• 格式設置：行高、自適應列寬、文字居中、自動換行、隱藏指定列、所有框線
  存在部分列設置自適應列寬，但效果不佳的，可以在代碼運行后手工調整
• 打印設置：橫向打印、頁邊距、打印標題、打印頁腳、凍結表格

Sub 工資表格式處理()'將每月2張工資表放在同一工作簿中，分別命名“行政、事業”，運行本代碼Dim title_row, title_h, row_h, bt, brr, ws, start_col&, b, i&, j&, gs&title_row = 3: title_h = 13.2: row_h = 24  '表頭行數，前2行行高，其他行高zbr_name = "制表人：薛定諤  " & Format(Date, "yyyy.mm.dd")bt = "職務工資,級別工資,崗位工資,薪級（技術）工資,教師（10%）," _& "績效獎金,生活補助,工作津貼,崗位津貼,降溫取暖費,公車改革補貼," _& "補發工資（停發）,應發工資,養老保險,職業年金,醫療保險,失業保險," _& "住房公積金,代扣個稅,單位代扣小計,代扣其它,實發合計"  '表頭及順序brr = Split(bt, ",")For Each ws In ActiveWorkbook.WorksheetsWith ws'格式設置：行高、居中、自動換行、合并單元格、隱藏D-E列.Rows.RowHeight = row_h: .Rows("1:2").RowHeight = title_h.Rows(3).RowHeight = 25.2    '第3行行高.Cells.HorizontalAlignment = xlCenter  '全表居中.Cells.VerticalAlignment = xlCenter.Rows(3).WrapText = True     '第3行自動換行.Columns(2).WrapText = True  '第2列自動換行，單位名稱.Cells(1, 1).UnMerge    '取消合并單元格，方便調整列排序.Columns("d:e").Hidden = True'添加合計行，刪除合計數為零的列，刪除“應發合計,扣款合計”列hb_row = .UsedRange.Rows.count + 1: .Cells(hb_row, 3) = "合計"For j = 6 To .UsedRange.Columns.count.Cells(hb_row, j).FormulaR1C1 = "=SUM(R[" & 4 - hb_row & "]C[0]:R[-1]C[0])"NextFor j = .UsedRange.Columns.count To 6 Step -1If .Cells(hb_row, j) = 0 Or .Cells(3, j) = "應發合計" _Or .Cells(3, j) = "扣款合計" Then .Columns(j).DeleteNext'調整列排序，剪切列、插入列start_col = 6  '開始列號For Each b In brrFor j = 6 To .UsedRange.Columns.countIf .Cells(3, j) = b ThenIf j <> start_col Then.Columns(j).Cut.Columns(start_col).InsertEnd Ifstart_col = start_col + 1: Exit For  '遞增、跳出End IfNextNextIf Month(Date) = 1 Then gs = 12 Else gs = Month(Date) - 1  '個稅所屬月份For j = .UsedRange.Columns.count To 6 Step -1If .Cells(3, j) = "代扣個稅" Then .Cells(3, j) = "代扣" & gs & "月個稅": Exit ForNext'增加第1列序號列，表頭合并單元格，所有框線，列寬自適應.Columns(1).Insert: .Cells(3, 1) = "序號"For i = 4 To .UsedRange.Rows.count - 1.Cells(i, 1) = i - 3Next.Cells(1, 2) = Replace(.Cells(1, 2).Value, "局", "局" & Month(Date) & "月").Cells(1, 1).Resize(2, .UsedRange.Columns.count).Merge.UsedRange.Borders.LineStyle = xlContinuousRange(.Columns(7), .Columns(.UsedRange.Columns.count)).ColumnWidth = 4Range(.Columns(7), .Columns(.UsedRange.Columns.count)).AutoFitRange(.Columns(1), .Columns(2)).AutoFit: .Columns(4).AutoFit.Cells(.UsedRange.Rows.count + 1, .UsedRange.Columns.count - 2) = zbr_name'設置工作表橫向打印、頁邊距、打印標題、打印頁腳、凍結表格With .PageSetup.Orientation = xlLandscape  '橫向打印.PrintTitleRows = "$1:$3"   '打印標題.TopMargin = Application.InchesToPoints(0.787)     '上邊距2厘米.BottomMargin = Application.InchesToPoints(0.787)  '下邊距2厘米.CenterFooter = "第 &P 頁，共 &N 頁"  '打印頁腳End WithEnd WithNext
End Sub

舉例

系統導出工資表，保存至同一個工作簿的不同工作表（部分截圖）

代碼處理后工資表

2，工資表數據統計

為便于賬務處理以及數據核對，對以上經過代碼處理的工資表進行數據統計
工資收入部分分別計入：基本工資、津貼補貼、績效獎金

Sub 工資表數據統計()'僅適用于統計經過以上代碼處理的工資表Dim dict1 As Object, dict2 As Object, jb$, jbt$, arr, brr, ws, res, i&, j&, gzxm$jb = "職務工資,級別工資,崗位工資,薪級（技術）工資,教師（10%）"  '基本工資jbt = "生活補助,工作津貼,崗位津貼,降溫取暖費,公車改革補貼"      '津貼補貼title_row = 3: start_col = 7  '表頭行號，開始列號Set dict1 = CreateObject("scripting.dictionary")brr = Split(jb, ",")For Each b In brrdict1(b) = "基本工資"Nextbrr = Split(jbt, ",")For Each b In brrdict1(b) = "津貼補貼"NextSet dict2 = CreateObject("scripting.dictionary")Set dict2("基本工資") = CreateObject("scripting.dictionary")  '字典嵌套Set dict2("津貼補貼") = CreateObject("scripting.dictionary")For Each ws In ActiveWorkbook.Worksheetsarr = ws.UsedRange.Value: ws_name = ws.Name: s = s + "," + ws_nametotal_row = ws.UsedRange.Rows.count - 1  '合計行號For j = start_col To UBound(arr, 2)gzxm = arr(title_row, j)  '工資項目If Not dict1.Exists(gzxm) And Not dict2.Exists(gzxm) Then  '不屬于基本工資、津貼補貼Set dict2(gzxm) = CreateObject("scripting.dictionary")ElseIf dict1.Exists(gzxm) Thengzxm = dict1(gzxm)    '屬于基本工資、津貼補貼，則轉換End Ifdict2(gzxm)(ws_name) = dict2(gzxm)(ws_name) + arr(total_row, j)NextNextk2 = dict2.keys: brr = Split(s, ",")  '字典dict2所有鍵轉為數組，拆分字符串sReDim res(1 To dict2.count + 1, 1 To UBound(brr) + 2)  '統計結果數組'橫縱條件賦值到數組For i = 2 To UBound(res)  '縱向res(i, 1) = k2(i - 2)NextFor j = 1 To UBound(brr)  '橫向res(1, j + 1) = brr(j)Nextres(1, UBound(res, 2)) = "合計"'數組結果賦值到res數組For i = 2 To UBound(res)  '縱向For j = 2 To UBound(res, 2) - 1  '橫向If dict2(res(i, 1)).Exists(res(1, j)) Thenres(i, j) = dict2(res(i, 1))(res(1, j))res(i, UBound(res, 2)) = res(i, UBound(res, 2)) + res(i, j)End IfNextNextWorksheets.Add(After:=Sheets(Sheets.count)).Name = "統計"  '添加工作表并命名Worksheets("統計").[a1].Resize(UBound(res), UBound(res, 2)) = resWith Worksheets("統計")  '格式設置.Cells.Font.Name = "宋體": .Cells.Font.Size = 12: .Rows.RowHeight = 20.Cells.HorizontalAlignment = xlCenter  '全表居中.Cells.VerticalAlignment = xlCenterRange(.Columns(1), .Columns(.UsedRange.Columns.count)).AutoFitEnd With
End Sub

舉例

對1-舉例處理結果進行統計：
部分統計結果的順序可能需要手工調整，如失業保險