【VBA研究】生成工资条

来源：互联网发布：mac qq截图不能使用编辑：程序博客网时间：2024/04/25 19:34

作者：iamlaosong

1、可以将工资表拆分成可以撕开单独使用的工资条，即每个人工资数额上面加上项目名称，每个人后面加一个空行，第一次写VBA程序，主要靠录制宏，代码很粗糙，数据和代码如下：

Sub 生成工资条()    '定义工作表名称    gzb = "Sheet1"   '工资表    gzt = "Sheet2"   '工资条        'num = InputBox("请输入总人数：")        num = 12        'col = InputBox("请输入工资表的栏数：")        col = 28        '删除原来的工资条    Sheets(gzt).Select    Range(Cells(1, 1), Cells(num * 3, col)).Select    Selection.Delete        num1 = 0        Do While num1 < num          '插入标题行            Sheets(gzb).Select        Range(Cells(1, 1), Cells(1, col)).Select        Application.CutCopyMode = False        Selection.Copy        Sheets("Sheet2").Select        Range(Cells(num1 * 3 + 1, 1), Cells(num1 * 3 + 1, col)).Select        ActiveSheet.Paste          '插入数据行            Sheets("Sheet1").Select        Range(Cells(num1 + 2, 1), Cells(num1 + 2, col)).Select        Application.CutCopyMode = False        Selection.Copy        Sheets("Sheet2").Select        Range(Cells(num1 * 3 + 2, 1), Cells(num1 * 3 + 2, col)).Select        ActiveSheet.Paste                num1 = num1 + 1        Loop        Range(Cells(1, 1), Cells(2, 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    num3 = 1    Do While num3 < num            '循环复制表格线样式                Range(Cells(num3 * 3 + 1, 1), Cells(num3 * 3 + 2, col)).Select        Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False        num3 = num3 + 1        LoopEnd Sub

2、上面只是练习VBA编程，其实不写程序也可以轻松完成工资条，方法如下：

（1）把标题行复制到另一个表中，然后在序号下输入数字1，然在在B2中输入下面公式并向右复制
=VLOOKUP($A2,销售部工资表!$A:$I,COLUMN(B1),0)
公式说明：Column(b1)在公式向右复制时生成2,3,4,5,6...数字，作为VLOOKUP的第3个参数。

（2）选取前三行向下复制。有多少人就复制多少次，拖拽复制也可以。复制后，工资条已自动生成。（如果中间隔2个空行则选前4行）