文/邓亚思

　　Excel具有强大的数据处理和打印输出功能，并且易学易用，是广大用户喜欢使用的电子表格处理软件。现在一些单位的财会人员喜欢用Excel打印本单位的职工工资总表与工资条，但在Excel中要将工资总表（如表1）手工地转换为工资条（如表2）则是一件比较烦琐的事，下面是我编写的一个Excel宏，运行这个宏就可将编辑好了的工资总表很方便地转换为工资条打印输出。

表1工资表

编号	日期	姓名	职务工资	各种补贴	应领数	扣水电	其他扣款	实发数
001	200109	邓卫平	432.50	525.50	958.00	80.50	15	862.50
002	200119	成文勇	425.00	500.00	925.50	75.00	15	835.50
…	…	…	…	…	…	…	…	…

　　在Excel中新建一个文件，将其命名为“工资表与工资条”，在工作表“sheet1”中输入并编辑好本单位职工工资总表（如表1所示）后，点击“工具”菜单→“宏”→“宏…”→输入宏名“生成工资条”→创建，输入如下的宏的各行文本，输入完成后保存该宏。将工作表“sheet1”复制为另一个工作表“sheet2”中，使“sheet2”成为当前工作表，执行刚才创建的宏，即可很快将表1所示的工资表转换为表2所示的工资条。

　　宏的内容如下：

　　Sub 生成工资条()

　　Cells.Select

　　'选择整个表去掉表格线

　　Range("F1").Activate

　　Selection.Borders(xlDiagonalDown).Line

　　Style = xlNone

　　Selection.Borders(xlDiagonalUp).LineStyle = xlNone

　　Selection.Borders(xlEdgeLeft).LineStyle = xlNone

　　Selection.Borders(xlEdgeTop).LineStyle = xlNone

　　Selection.Borders(xlEdgeBottom).LineStyle = xlNone

　　Selection.Borders(xlEdgeRight).LineStyle = xlNone

　　Selection.Borders(xlInsideVertical).LineStyle = xlNone

　　Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

　　Rows("2:2").Select

　　'选择第2行

　　Selection.Insert Shift:=xlDown

　　 '在第2行前插入一行，保持第2行

　　为选中状态

　　num=150

　　'总人数×3，如工资表中有100人则

　　为100×3即num=300

　　col=14

　　'工资表的栏数，如工资表有17栏则

　　 'col=17

　　num1 = 4

　　Do While num1 <= num

　　'循环插入空行

　　Range(Cells(num1, 1), Cells(num1, col)).Select

　　'选中第num1行的第1列到第col列

　　Selection.Insert Shift:=xlDown

　　Selection.Insert Shift:=xlDown

　　num1 = num1 + 3

　　Loop

　　Range(Cells(1, 1), Cells(1, col)).Select

　　Application.CutCopyMode = False

　　'剪切复制模式无效

　　Selection.Copy

　　'复制选择区域

　　Range("A2").Select

　　'选择A2单元格

　　ActiveSheet.Paste

　　'从A2单元格起粘贴内容

　　num2 = 5

　　Do While num2 <= num

　　'循环插入标题行

　　Range(Cells(1, 1), Cells(1, col)).Select

　　Application.CutCopyMode = False

　　Selection.Copy

　　Cells(num2, 1).Select

　　ActiveSheet.Paste

　　num2 = num2 + 3

　　Loop

　　Range(Cells(2, 1), Cells(3, col)).Select

　　Application.CutCopyMode = False

　　Selection.Borders(xlDiagonalDown).LineStyle

　　 = xlNone

　　 '定义表格边框线、内线样式

　　Selection.Borders(xlDiagonalUp).LineStyle = xlNone

　　With Selection.Borders(xlEdgeLeft)

　　.LineStyle = xlDouble

　　.Weight = xlThick

　　.ColorIndex = xlAutomatic

　　End With

　　With Selection.Borders(xlEdgeTop)

　　.LineStyle = xlDouble

　　.Weight = xlThick

　　.ColorIndex = xlAutomatic

　　End With

　　With Selection.Borders(xlEdgeBottom)

　　.LineStyle = xlDouble

　　.Weight = xlThick

　　.ColorIndex = xlAutomatic

　　End With

　　With Selection.Borders(xlEdgeRight)

　　.LineStyle = xlDouble

　　.Weight = xlThick

　　.ColorIndex = xlAutomatic

　　End With

　　With Selection.Borders(xlInsideVertical)

　　.LineStyle = xlDash

　　.Weight = xlThin

　　.ColorIndex = xlAutomatic

　　End With

　　With Selection.Borders(xlInsideHorizontal)

　　.LineStyle = xlDash

　　.Weight = xlThin

　　.ColorIndex = xlAutomatic

　　End With

　　Selection.Copy

　　Range(Cells(5, 1), Cells(6, col)).Select

　　Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

　　 False, Transpose:=False

　　'接上行删除上行尾的连字符

　　 _，复制表格线样式

　　num3 = 8

　　Do While num3 ＜= num

　　'循环复制表格线样式

　　Range(Cells(num3, 1), Cells(num3 + 1, col))

　　.Select

　　Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _

　　 False, Transpose:=False

　　num3 = num3 + 3

　　Loop

　　Rows("1:1").Select

　　'删除多余的一行

　　Selection.Delete

　　End Sub

　　以后每月要打印工资表与工资条时，只需将“工资表与工资条”文件打开，修改好工作表“sheet1”中的当月的工资总表数据后将其复制为工作表“sheet2”，并使“sheet2”成为当前工作表，执行宏“生成工资条”即可。

　　

【发表评论】【初学者园地】【科技聊天】【关闭窗口】