Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 5115|回复: 16

[已解决]工资条代码修正

[复制链接]
发表于 2017-8-4 15:25 | 显示全部楼层 |阅读模式
本帖最后由 czl103 于 2017-8-9 10:05 编辑

附件为工资条表格附带VBA代码,运行结果有个小问题,第三行应为空行,结果却是第二个工资条的表头了。

哪位大神帮忙看一下,谢谢!

修正后代码:
Sub 工资条大灰狼()
Dim i&
Application.ScreenUpdating = False
For i = [a65536].End(3).Row To 3 Step -1
Rows(1).Copy
Rows(i).Insert shift:=xlDown
Rows(i).Insert shift:=xlDown
Next i
Application.ScreenUpdating = True
End Sub


最佳答案
2017-8-9 08:49
czl103 发表于 2017-8-8 17:19
哦了 美中不足的就是34行以后还有9行空的标题,可否把这些去除?

测试没有发生你所说的问题,附件请测试。
是不是你的A列下面有什么数据,我是判断A列最末行后再进行处理的。
如果可以,把有问题的附件还原后发上来。
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-8-4 16:02 | 显示全部楼层
Sub 插入行()
R = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For xin = 3 To (R * 2) Step 2
ActiveSheet.Rows(xin).Insert shift:=xlDown
Next
End Sub
回复

使用道具 举报

发表于 2017-8-4 16:03 | 显示全部楼层
你是录制的代码容易错误,还是要自己手写才有保障
回复

使用道具 举报

 楼主| 发表于 2017-8-4 16:19 | 显示全部楼层
qdwfjmqj 发表于 2017-8-4 16:02
Sub 插入行()
R = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For xin = 3 To (R * 2) Step 2

这个可以实现插入行的效果,如何才能把这个跟复制工资条标题合并起来呢?
回复

使用道具 举报

 楼主| 发表于 2017-8-4 16:35 | 显示全部楼层
qdwfjmqj 发表于 2017-8-4 16:02
Sub 插入行()
R = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For xin = 3 To (R * 2) Step 2

这个是没有空行的工资条代码:
Sub 工资条()
    Dim X As Integer
    Range("A1").Select
    For X = 1 To Range("a1048576").End(xlUp).Row - 2
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Copy
    ActiveCell.Offset(2, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown
    ActiveCell.Select
    Next X
    End Sub


回复

使用道具 举报

发表于 2017-8-4 17:41 | 显示全部楼层
Sub 插入行()
r = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
r = r * 2
For xin = 3 To (r - 2) Step 2
ActiveSheet.Rows(xin).Insert shift:=xlDown
ActiveSheet.Range("A1:G1").Copy ActiveSheet.Range("A" & xin)
Next
End Sub
回复

使用道具 举报

发表于 2017-8-5 11:42 | 显示全部楼层
czl103 发表于 2017-8-4 16:35
这个是没有空行的工资条代码:
Sub 工资条()
    Dim X As Integer

Sub 制作工资条()
'
' 制作工资条 宏
'
' 快捷键: Ctrl+q
'
    ActiveCell.Offset(2, 0).Rows("1:2").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-2, 0).Rows("1:1").EntireRow.Select
    Selection.Copy
    ActiveCell.Offset(3, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveCell.Offset(1, 0).Range("A1").Select
End Sub

回复

使用道具 举报

 楼主| 发表于 2017-8-7 14:21 | 显示全部楼层
qdwfjmqj 发表于 2017-8-4 17:41
Sub 插入行()
r = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
r = r * 2

这个运行出来也是没有空行哈
回复

使用道具 举报

 楼主| 发表于 2017-8-7 14:28 | 显示全部楼层
zhengyixin 发表于 2017-8-5 11:42
Sub 制作工资条()
'
' 制作工资条 宏

这个运行以后,结果只有第六行为空行,还复制了“1013”行到第七行,别的都没动啊。
工资表.jpg
回复

使用道具 举报

发表于 2017-8-8 14:35 | 显示全部楼层
插入行+复制表头,用你SHEET2的数据做的测试。
  1. Sub aaa()
  2. Dim i&
  3. Application.ScreenUpdating = False
  4. For i = [a65536].End(3).Row To 3 Step -1
  5.   Rows(1).Copy
  6.   Rows(i).Insert shift:=xlDown
  7. Next i
  8. Application.ScreenUpdating = True
  9. End Sub
复制代码
回复

使用道具 举报

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

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 17:48 , Processed in 0.454618 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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