ExcelVBA工资条制作

2022-10-25 13:13:01 浏览数 (2)

ExcelVBA工资条制作

工资条的制作,本资源来自于网络,下面我们看一下要求与效果

========代码如下========

Sub 生成工资条()

On Error Resume Next

Dim k As Range, intRow%

Set k = Application.InputBox("请选择工资条的标题行:","请选择", Type:=8)

If k Is Nothing Then Exit Sub

ti = Timer()

k.Cells(1).EntireRow.Insert shift:=xlDown

Set k = k.Offset(-1, 0).EntireRow.Resize(k.Rows.Count 1)

k.Select

intRow = 1

Application.ScreenUpdating = False

With ActiveSheet

Do

k.EntireRow.Copy

.Rows(intRow * (k.Rows.Count 1) k.Cells(1).Row).Insert shift:=xlDown

intRow = intRow 1

Loop While .Cells(intRow * (k.Rows.Count 1) k.Cells(1).Row,k.Column) <> ""

End With

ActiveSheet.Name = "工资条"

Application.CutCopyMode = False

Application.ScreenUpdating = True

Set k = Nothing

MsgBox "工资条制作完成,时间:" &Format(Timer - ti, "00.00秒")

End Sub

=====工作原理=======

这是从开始行插入法:工作原理,先取得工资条的标题--在前面插入一个空行—把这个空行与标题做为一个整体给k—复制k在intRow * (k.Rows.Count 1) k.Cells(1).Row第几k总行 1 k的起始行号处复制插入整体k,---到最后没有数据行为止,

关闭闪屏:代码

Application.ScreenUpdating = False

Application.ScreenUpdating = True

此类型代码一般都是成对出现,一般在过程的开头“禁用”某功能,但在过程的结尾就要“恢复”Excel程序的该项功能。

=====效果图=====

0 人点赞