Excel·VBA制作工资条

看到一篇博客《excel表头_Excel工资表怎么做？3分钟学会利用函数生成工资表》，使用排序功能、函数制作工资条。但如果需要经常制作工资条，显然使用VBA更加方便

VBA制作工资条

Sub 制作工资条()
    Dim title_row&, blank_row&, ws_new$, title_rng As Range, ws As Worksheet, arr, num_col&, r&, i&
'--------------------参数填写：
    title_row = 1: blank_row = 2: ws_new = "工资条"  '表头行数，间隔空白行数，生成的表格名称
    Set ws = ActiveSheet  '工资表，即当前工作表
    arr = ws.[a1].CurrentRegion: num_col = UBound(arr, 2): Dim col_width As Boolean
    Set title_rng = ws.[a1].Resize(title_row, num_col): col_width = False
    On Error Resume Next  '利用错误捕获，判断是否包含工作表，不包含则新建
    Debug.Print Sheets(ws_new).Name
    If Err.Number = 9 Then Worksheets.Add(after:=Sheets(Sheets.Count)).Name = ws_new
    With Worksheets(ws_new)
        r = 1
        For i = title_row + 1 To UBound(arr)
            title_rng.Copy .Cells(r, 1)  '复制表头和数据
            ws.Cells(i, 1).Resize(1, num_col).Copy .Cells(r + title_row, 1)
            If Not col_width Then  '复制列宽
                title_rng.Copy
                .Cells(r, 1).PasteSpecial (xlPasteColumnWidths)
                col_width = True
            End If
            With .Cells(r, 1).CurrentRegion  '设置外框线，无需可注释代码
                .Borders.LineStyle = xlContinuous  '所有框线
                .Borders(xlInsideVertical).LineStyle = xlNone  '取消内框线
                .Borders(xlInsideHorizontal).LineStyle = xlNone
            End With
            r = r + title_row + blank_row + 1
        Next
    End With
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

举例

扩展阅读：
《百度经验-Excel制作工资条的三种方法》