VBA多格式工资条批量生成

sanjianjian

急求大侠指点

sanjianjian

最终表中的空白行可以不考虑

清风竹-

请看附件。

huarong7984

本资料系本人为单位人事科朋友所做，表内数据已换为虚拟。仅供参考。

gwjkkkkk

Sub TEST()
Dim arr, i&, Rng As Range, N&
arr = Range(Cells(Rows.Count, "E").End(xlUp), "A1")
N = 1: Sheets(2).Cells.Clear
For i = 1 To UBound(arr)
   If arr(i, 1) <> "" Then
      If arr(i, 1) = "序号" Then
         Set Rng = Cells(i, 1).Resize(, UBound(arr, 2))
      Else
         Union(Cells(i, 1).Resize(, UBound(arr, 2)), Rng).Copy Sheets(2).Cells(N, 1)
         N = N + 2
      End If
   End If
Next i
Beep
End Sub

gwjkkkkk

代码审核中，请参考附件。。。

ddmc

这个现在还发纸条性质的工资条？？

不直接发pdf 的微信文件？

sanjianjian

gwjkkkkk 发表于 2022-11-22 19:45
代码审核中，请参考附件。。。

大侠，如果首单元格是其他值（不在取数范围内），并且实际数列达到BH，此时代码失效。请问需怎么调整？F:\360MoveData\Users\Administrator\Desktop\1669174231771（尤其是实际数列达到BH时）

gwjkkkkk

1.循环从每2行开始
2.取值范围改成arr = ActiveSheet.UsedRange
没有附件只能跟你这样说。。。

grf1973

数据量不大的话直接复制单元格。省得调格式。