Excel·VBA江西省预算一体化工资表一键处理

每月制作工资表导出为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-举例处理结果进行统计：
部分统计结果的顺序可能需要手工调整，如失业保险