ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2076|回复: 11

[求助] 一键生成工资条,帮帮忙。。谢谢

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-3-4 19:10 | 显示全部楼层 |阅读模式
本帖最后由 努力学习01 于 2020-3-4 19:35 编辑

VBA一键生成工资条.zip (21.58 KB, 下载次数: 9)

附件里面有详细的要求说明。

找了论坛里的,看不懂代码。。所以另发帖求助了。。谢谢啦。。

不明白在线解释谢谢。。。

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-4 20:57 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

《工资条制作程序》V1.0.zip (45.58 KB, 下载次数: 5)
老师们看看这个吧。。
如果条目上没有合并单元格运行代码是正常的,
但是条目上的“序号”被我合并了单元格了,就出现下面错误,帮忙看看把。
QQ截图20200303133332.png
微信截图_20200304205409.png

TA的精华主题

TA的得分主题

发表于 2020-3-4 21:34 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
楼主看下对应的表格A列,有合并单元格处在交叉位置

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-4 21:55 | 显示全部楼层
liulang0808 发表于 2020-3-4 21:34
楼主看下对应的表格A列,有合并单元格处在交叉位置

对呀版主。。我知道A列,表头里有合并单元格,就是因为有才会出错。。

能不能帮我改下。。不管表头有没有合并单元格。。一样能执行代码。。不出错

TA的精华主题

TA的得分主题

发表于 2020-3-4 22:17 | 显示全部楼层
  1. Sub test()
  2.   Dim r%, i%
  3.   Dim arr, brr
  4.   Dim rng As Range
  5.   Dim ws As Worksheet
  6.   Dim hg(1 To 4) As Double
  7.   Dim lk() As Double
  8.   Application.ScreenUpdating = False
  9.   Application.DisplayAlerts = False
  10.   Set ws = Worksheets("工资条")
  11.   With ws
  12.     .Cells.Clear
  13.   End With
  14.   With Worksheets("工资总表")
  15.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
  16.     c = .Cells(3, .Columns.Count).End(xlToLeft).Column
  17.     For i = 3 To 6
  18.       hg(i - 2) = .Rows(i).RowHeight
  19.     Next
  20.     ReDim lk(1 To c)
  21.     For j = 1 To c
  22.       lk(j) = .Columns(j).ColumnWidth
  23.     Next
  24.     m = 1
  25.     For i = 6 To r
  26.       .Range("a3:ad5").Copy ws.Cells(m, 1)
  27.       .Cells(i, 1).Resize(1, 30).Copy ws.Cells(m + 3, 1)
  28.       For k = 1 To 4
  29.         ws.Rows(m + k - 1).RowHeight = hg(k)
  30.       Next
  31.       ws.Rows(m + 4).Resize(2, 1).RowHeight = 4.5
  32.       With ws.Cells(m + 5, 1).Resize(1, 30).Borders(xlEdgeTop)
  33.         .LineStyle = xlContinuous
  34.         .Weight = xlHairline
  35.       End With
  36.       m = m + 6
  37.     Next
  38.     For j = 1 To UBound(lk)
  39.       ws.Columns(j).ColumnWidth = lk(j)
  40.     Next
  41.   End With
  42. End Sub

复制代码

TA的精华主题

TA的得分主题

发表于 2020-3-4 22:19 | 显示全部楼层
详见附件。

VBA一键生成工资条.rar

36.56 KB, 下载次数: 16

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-3-5 00:14 | 显示全部楼层

老师。。已经满足我的要求了。。但是又一点,是我忘记说了。。

就是。表头。行数固定了。。但是。。列数不一定到AD列。。

能不能修改下。。无论多少列数据都能实现的那种。

TA的精华主题

TA的得分主题

发表于 2020-3-5 06:26 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
努力学习01 发表于 2020-3-5 00:14
老师。。已经满足我的要求了。。但是又一点,是我忘记说了。。

就是。表头。行数固定了。。但是。。列 ...
  1. Sub test()
  2.   Dim r%, i%
  3.   Dim arr, brr
  4.   Dim rng As Range
  5.   Dim ws As Worksheet
  6.   Dim hg(1 To 4) As Double
  7.   Dim lk() As Double
  8.   Application.ScreenUpdating = False
  9.   Application.DisplayAlerts = False
  10.   Set ws = Worksheets("工资条")
  11.   With ws
  12.     .Cells.Clear
  13.   End With
  14.   With Worksheets("工资总表")
  15.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
  16.     c = .Cells(3, .Columns.Count).End(xlToLeft).Column
  17.     For i = 3 To 6
  18.       hg(i - 2) = .Rows(i).RowHeight
  19.     Next
  20.     ReDim lk(1 To c)
  21.     For j = 1 To c
  22.       lk(j) = .Columns(j).ColumnWidth
  23.     Next
  24.     m = 1
  25.     For i = 6 To r
  26.       .Range("a3:ad5").Copy ws.Cells(m, 1)  ‘这里是调整表头的,你看看你的表头到哪个单元格,ad5改成就行了
  27.       .Cells(i, 1).Resize(1, 30).Copy ws.Cells(m + 3, 1)   ’这里头Resize(1, 30),30是管着你下边复制多宽的,列多了你就数数多少改大点
  28.       For k = 1 To 4
  29.         ws.Rows(m + k - 1).RowHeight = hg(k)
  30.       Next
  31.       ws.Rows(m + 4).Resize(2, 1).RowHeight = 4.5
  32.       With ws.Cells(m + 5, 1).Resize(1, 30).Borders(xlEdgeTop)
  33.         .LineStyle = xlContinuous
  34.         .Weight = xlHairline
  35.       End With
  36.       m = m + 6
  37.     Next
  38.     For j = 1 To UBound(lk)
  39.       ws.Columns(j).ColumnWidth = lk(j)
  40.     Next
  41.   End With
  42. End Sub

复制代码



我是菜鸟,不会写,凑合能改改

TA的精华主题

TA的得分主题

发表于 2020-3-5 07:48 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
Sub take3()
Application.ScreenUpdating = False
   take4
   
    Dim i As Integer
    Dim a
    a = 6
    Rows("1:5").UnMerge
    For i = 1 To Range("a10000").End(xlUp).Rows
    Rows("1:5").Select
    Selection.Copy

    Rows(a & ":" & a).Select
    Selection.Insert Shift:=xlDown
    Range("H16").Select
    a = a + 6
    Next

评分

2

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-3-5 08:47 | 显示全部楼层
修改好了。

VBA一键生成工资条.rar

36.57 KB, 下载次数: 19

评分

1

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-28 18:07 , Processed in 0.055303 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表