每月制作工资表导出为Excel后都需要调整格式，删除0数据的列、对工资表项目进行排序、打印设置等等，有些单位还分有“行政”、“事业”2个工资表就需要操作2次。显然，这种重复操作的问题，可以使用VBA代码解决
目录
- 代码使用说明
- 1，工资表格式处理
- 涉及功能
- 举例
- 2，工资表数据统计
- 举例
代码使用说明
- 代码作用范围：以下代码作用于活动工作簿/工作表，无需将待处理的工资表保存在启用宏的工作簿中（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.Worksheets
With 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])"
Next
For j = .UsedRange.Columns.count To 6 Step -1
If .Cells(hb_row, j) = 0 Or .Cells(3, j) = "应发合计" _
Or .Cells(3, j) = "扣款合计" Then .Columns(j).Delete
Next
'调整列排序，剪切列、插入列
start_col = 6 '开始列号
For Each b In brr
For j = 6 To .UsedRange.Columns.count
If .Cells(3, j) = b Then
If j <> start_col Then
.Columns(j).Cut
.Columns(start_col).Insert
End If
start_col = start_col + 1: Exit For '递增、跳出
End If
Next
Next
If Month(Date) = 1 Then gs = 12 Else gs = Month(Date) - 1 '个税所属月份
For j = .UsedRange.Columns.count To 6 Step -1
If .Cells(3, j) = "代扣个税" Then .Cells(3, j) = "代扣" & gs & "月个税": Exit For
Next
'增加第1列序号列，表头合并单元格，所有框线，列宽自适应
.Columns(1).Insert: .Cells(3, 1) = "序号"
For i = 4 To .UsedRange.Rows.count - 1
.Cells(i, 1) = i - 3
Next
.Cells(1, 2) = Replace(.Cells(1, 2).Value, "局", "局" & Month(Date) & "月")
.Cells(1, 1).Resize(2, .UsedRange.Columns.count).Merge
.UsedRange.Borders.LineStyle = xlContinuous
Range(.Columns(7), .Columns(.UsedRange.Columns.count)).ColumnWidth = 4
Range(.Columns(7), .Columns(.UsedRange.Columns.count)).AutoFit
Range(.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 With
End With
Next
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 brr
dict1(b) = "基本工资"
Next
brr = Split(jbt, ",")
For Each b In brr
dict1(b) = "津贴补贴"
Next
Set dict2 = CreateObject("scripting.dictionary")
Set dict2("基本工资") = CreateObject("scripting.dictionary") '字典嵌套
Set dict2("津贴补贴") = CreateObject("scripting.dictionary")
For Each ws In ActiveWorkbook.Worksheets
arr = ws.UsedRange.Value: ws_name = ws.Name: s = s + "," + ws_name
total_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) Then
gzxm = dict1(gzxm) '属于基本工资、津贴补贴，则转换
End If
dict2(gzxm)(ws_name) = dict2(gzxm)(ws_name) + arr(total_row, j)
Next
Next
k2 = dict2.keys: brr = Split(s, ",") '字典dict2所有键转为数组，拆分字符串s
ReDim res(1 To dict2.count + 1, 1 To UBound(brr) + 2) '统计结果数组
'横纵条件赋值到数组
For i = 2 To UBound(res) '纵向
res(i, 1) = k2(i - 2)
Next
For j = 1 To UBound(brr) '横向
res(1, j + 1) = brr(j)
Next
res(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)) Then
res(i, j) = dict2(res(i, 1))(res(1, j))
res(i, UBound(res, 2)) = res(i, UBound(res, 2)) + res(i, j)
End If
Next
Next
Worksheets.Add(After:=Sheets(Sheets.count)).Name = "统计" '添加工作表并命名
Worksheets("统计").[a1].Resize(UBound(res), UBound(res, 2)) = res
With Worksheets("统计") '格式设置
.Cells.Font.Name = "宋体": .Cells.Font.Size = 12: .Rows.RowHeight = 20
.Cells.HorizontalAlignment = xlCenter '全表居中
.Cells.VerticalAlignment = xlCenter
Range(.Columns(1), .Columns(.UsedRange.Columns.count)).AutoFit
End With
End Sub
举例
对1-举例处理结果进行统计：
部分统计结果的顺序可能需要手工调整，如失业保险
