如何用VBA自定义函数并调用生成工资条?

作者：绿色风分类：时间：2022-08-17 浏览：124

楼主
DJ_Soo

Q:如何用VBA自定义函数并调用生成工资条?
因财务人员经常要做工资条来给员工派发工资,但是技巧的操作还是感觉比较麻烦，那么能否有更智能的方法给财务人员实现自动化生成工资条不？可以通过编写VBA自定义函数，然后在模块程序中进行调用，即可实现自动化生产工资条。
A:ALT+F11→插入模块→在模块中输入以下代码：

Function paySlip(arr As Variant, RowStep As Byte)
Dim Col As Byte
Dim lstCol As Byte
Dim Ro As Long
Dim LstRo As Long
Dim resRo As Long
Dim arrRes() As String
Dim CntRo As Long
Dim arrHeader As Variant
LstRo = UBound(arr, 1)
lstCol = UBound(arr, 2)
resRo = (RowStep + 2) * (LstRo - 1)'计算数组应该有几行
arrHeader = WorksheetFunction.Index(arr, 1)'取得第一行为表头
ReDim arrRes(1 To resRo, 1 To lstCol)'重新定义最终数组的大小
CntRo = 1'因为是从arr的第二行开始,所以先初始化CntRo为1
For Ro = 1 To resRo Step RowStep + 2
CntRo = CntRo + 1
For Col = 1 To lstCol
arrRes(Ro, Col) = arrHeader(Col)
arrRes(Ro + 1, Col) = arr(CntRo, Col)
Next Col
Next Ro
paySlip = arrRes
End Function

其中参数中arr代表工资区域,第一行需要是表头.RowStep为每条工资直接空行数.
处理如下的工资表:

随便写代码调用此函数(当然应用时可以更灵活,举例我是随便弄一个).

Sub mkPaySlip()
Dim arr As Variant
Dim arrHeader As Variant
Dim RowStep As Byte
Dim LstRo As Long
Dim lstCol As Byte
Dim arrRes As Variant
With ActiveSheet
LstRo = .cells(Rows.count,1).End(xlUp).Row
lstCol = .cells(2,columns.count).End(xlToLeft).Column
arr = .[A2].Resize(LstRo - 1, lstCol)
RowStep = Application.InputBox("请输入要空几行:", Type:=1)
.[A2].Resize(LstRo - 1, lstCol).Clear
arrRes = paySlip(arr, RowStep)
.[A2].Resize(UBound(arrRes, 1), UBound(arrRes, 2)) = arrRes
End With
End Sub

效果如下:(如果看不清可以点击图片另开窗口看动画)

当然在看到我的操作的时候大家或许会觉得需要有还原源数据的功能,但是我觉得倒是不需要,因为是自定义函数,应用灵活一点直接把结果生成到新表中就不会破坏源数据了.

2楼
lnt1231

收藏了,谢谢分享.

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表