怎么样把工资表转变成工资条 ，主要是公司的员工很多，不可能一个一个去复制，谢谢了

Question

如题所述

Answer 1

Excel具有强大的数据处理和打印输出功能，并且易学易用，是广大用户喜欢使用的电子表格处理软件。现在一些单位的财会人员喜欢用Excel打印本单位的职工工资总表与工资条，但在Excel中要将工资总表手工地转换为工资条则是一件比较烦琐的事。本人从网上收集N种方法，供有这个需要的朋友们参考。其中有的本人经过了实际试验，有的还没有。

一、重新排序法

在Excel2000做成的工资表，只有第一个人有工资条的条头（如编号、姓名、岗位工资，年限工资……），想输出成工资条的形式。怎么做？
　　解决方法：
　　（1）、假设原工资表为“表1”，先复制“表1”到某新空白表中，命名为“表2”，删去“表2”中的多余行，使工资条头位于第一行，职工工资数据依次紧排在条头之后。：
　　（2）、在“表2”工资数据的后一列H中，增加“标注”栏，依次向下填充入1，2，3…等步长为1的序列数。
　　（3）、选中“表2”工资条头下（工资条头不选）第2至最后一行，右键：插入，表2中将出现许多新增空行，将条头数据填入这些新增空行中（方法：选中A1：G1，右键“复制”，然后选中所有新增空行，右键“粘贴”即可，也可用拖拽填充法）。然后在其“标注”栏中依次填上1.5，2.5，3.5…。等步长为1的序列数。操作结果示意如下：
　　（4）、再次选中“表2”第2行至最后一行，点击菜单：数据-排序-按“标注”列（递增）排序，点击确定。再选中H“标注”列，右键：“隐藏”或“删除”，这样，工资条即基本制作完毕。
　　（5）、制作完成的工资条裁开后即可分发给同事了。您如果觉得此表格过于拥挤，还可用类似的方法在每个人之间插入空行。

二、宏命令法

在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”成为当前工作表，执行宏“生成工资条”即可。

三、宏命令法（2）

在日常应用中，我们经常遇到这样的操作，每隔相等的几行，要重复做相同的事情。比如做工资条要打印时，每条记录前插入一个标题列；每隔N行的行高，统一调整为X高等。用常规的操作，如果数据少的话还可以承受，但数据量一大，就变成一件苦差事了。
下面这个宏，能够按指定的选择来选择等差行，选选择N至N+M行，然后再运行此宏，就可以选择从N行开始，每隔M行至到数据结束的行了，代码如下：
Sub SelectRange()
'按选择区域给定参数选择等差行
Dim i As Integer, XRan As Range
If Selection.Areas.Count > 1 Then
MsgBox "选择区域应为连续区域！", vbExclamation, "错误"
ElseIf Selection.Row > ActiveSheet.UsedRange.Rows.Count Then
MsgBox "选择区域应在使用区域内！", vbExclamation, "错误"
Else
Set XRan = Rows(Selection.Row)
For i = Selection.Row + Selection.Rows.Count To _
ActiveSheet.UsedRange.Rows.Count Step Selection.Rows.Count
Set XRan = Union(XRan, Rows(i))
Next
XRan.Select
End If

四、宏命令法（3）

Attribute VB_Name = "模块1"
Sub 生成工资条()
Cells.Select
'选择整个表去掉表格线
Range("F1").Activate
Selection.Borders(xlDiagonalDown).LineStyle = 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 = ((ActiveSheet.UsedRange.Rows.Count) - 2) * 3
'这个数字是工资表中总人数乘以3，例如工资表中有20人，就是num=60
col = ActiveSheet.UsedRange.Columns.Count
'这个数字是工资表中的列数，例如工资表中有20列，就是col=20
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

Answer 2

我这有个Excel的工资表，里面可以自己转换成工资条，很方便，需要的话可以发给你。追问

我的邮箱是[email protected],你发到这个里面了

追答

已发送，[email protected]发的，希望对你有所帮助。

本回答被提问者采纳