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 BooleanSet title_rng = ws.[a1].Resize(title_row, num_col): col_width = FalseOn Error Resume Next  '利用错误捕获，判断是否包含工作表，不包含则新建Debug.Print Sheets(ws_new).NameIf Err.Number = 9 Then Worksheets.Add(after:=Sheets(Sheets.Count)).Name = ws_newWith Worksheets(ws_new)r = 1For 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 = TrueEnd IfWith .Cells(r, 1).CurrentRegion  '设置外框线，无需可注释代码.Borders.LineStyle = xlContinuous  '所有框线.Borders(xlInsideVertical).LineStyle = xlNone  '取消内框线.Borders(xlInsideHorizontal).LineStyle = xlNoneEnd Withr = r + title_row + blank_row + 1NextEnd With
End Sub