【VBA研究】生成工资条

作者：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
    
    Loop
End 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行）