求修改生成工资条代码，谢谢！

xyxcc177

我用一个插件做的结果

凌空一羽

dssrmyh 发表于 2018-8-9 10:41
请老师在优化一下代码：人员不是每月固定的，有时多，有时少，要求生成的工资条是随人员数生成（如果人数 ...

工资条.zip (80.26 KB, 下载次数: 9)

2018-8-9 11:23 上传

点击文件名下载附件

weisilisid

做了一个如图

dssrmyh

凌空一羽 发表于 2018-8-9 11:23

谢谢，另外就是生成工资条如何不导入工资表中实领金额后两栏数据。谢谢！！！

dssrmyh

xyxcc177 发表于 2018-8-9 11:22
我用一个插件做的结果

谢谢了！！！

dssrmyh

weisilisid 发表于 2018-8-9 11:43
做了一个如图

谢谢了！！！

凌空一羽

dssrmyh 发表于 2018-8-9 12:11
谢谢，另外就是生成工资条如何不导入工资表中实领金额后两栏数据。谢谢！！！

Sub lkyy()
ar = Range("a1").CurrentRegion
ym = Replace(Split(ar(1, 1), "月")(0), "年", ".")
myl = UBound(ar, 2) - 2
ReDim br(1 To UBound(ar) * 4, 1 To myl)
myr = Range("b2").End(xlDown).Row
For i = 3 To myr
    n = ar(i, 1)
    For j = 2 To myl
        br(n * 4 - 3, j - 1) = ar(2, j)
        br(n * 4 - 2, j - 1) = ar(i, j)
    Next
    br(n * 4 - 3, myl) = "月份"
    br(n * 4 - 2, myl) = ym
Next
Sheets("工资条").Activate
Cells.ClearContents
Range("a5:r20000").Borders.LineStyle = xlNone
For i = 2 To n
    Rows("1:4").Copy Cells(i * 4 - 3, 1)
Next
Range("a1").Resize(n * 4, UBound(br, 2)) = br
End Sub

dssrmyh

凌空一羽 发表于 2018-8-9 12:20
Sub lkyy()
ar = Range("a1").CurrentRegion
ym = Replace(Split(ar(1, 1), "月")(0), "年", ".")

完美解决，谢谢！！！

dssrmyh

凌空一羽 发表于 2018-8-9 11:23

请再帮忙优化一下，生成工资条是只想保留最上面那个超链接图标，谢谢！

dssrmyh

顶上去，别沉