Excel精英培训网

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

[已解决]急 请教 如何在每行下插入相同的行数,并复制上一行的内容

[复制链接]
发表于 2012-11-23 20:37 | 显示全部楼层 |阅读模式
请教 如何在每行下插入相同的行数,并复制上一行的内容?
非常感激您的回复。
最佳答案
2012-11-23 21:48
本帖最后由 hwc2ycy 于 2012-11-23 21:51 编辑
  1. Sub 插行2()
  2.     Dim rg As Range
  3.     Dim StartRow&, EndRow&, InsertRow&, i&, msg$, Result
  4.     On Error Resume Next
  5.     Do
  6.         Set rg = Application.InputBox("请选择要复制的区域:", , , , , , , 8)
  7.         If rg Is Nothing Then Exit Sub
  8.         StartRow = rg.Row
  9.         EndRow = rg.Rows.Count + StartRow - 1
  10.         InsertRow = Application.InputBox("请输入要复制的行数", , , , , , , 1)
  11.         If InsertRow < =0 Then Exit Sub
  12.         msg = "要复制的区域为:" & rg.Address(False, False) & vbCr & "要复制的行数为:" & InsertRow
  13.         Result = MsgBox(msg, vbOKCancel + vbApplicationModal, "确认!")
  14.     Loop While Result = 2
  15.    
  16.     Application.ScreenUpdating = False
  17.     For i = EndRow + 1 To StartRow - 1 Step -1
  18.         Rows(i - 1).Copy
  19.         Rows(i).Resize(InsertRow).Insert
  20.     Next
  21.     Application.CutCopyMode = False
  22.     Application.ScreenUpdating = True
  23. End Sub
复制代码
改进版,可自由选择区域,及要复制的行数。
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2012-11-23 21:02 | 显示全部楼层
本帖最后由 bbwsj 于 2012-11-23 21:13 编辑

图图.gif

插入多行,


图图2.gif
回复

使用道具 举报

发表于 2012-11-23 21:14 | 显示全部楼层
如果要用VBA来实现这个功能,你只要记住一条,从下往上插就对了。
回复

使用道具 举报

发表于 2012-11-23 21:21 | 显示全部楼层
可以参考工资条的制作方法。http://www.excelpx.com/home/show.aspx?id=34919&cid=18
回复

使用道具 举报

发表于 2012-11-23 21:26 | 显示全部楼层
333.gif
回复

使用道具 举报

发表于 2012-11-23 21:26 | 显示全部楼层
  1. Sub 插行()
  2.     Application.ScreenUpdating = False
  3.     Dim InsertRowNum&
  4.     Dim EndRow&, i&
  5.     InsertRowNum = 3    '插入复制行数
  6.     EndRow = Range("a" & Rows.Count).End(xlUp).Row
  7.     If EndRow = 1 Then Exit Sub
  8.     For i = EndRow + 1 To 2 Step -1
  9.         Rows(i - 1).Copy
  10.         Rows(i).Resize(InsertRowNum).Insert
  11.     Next
  12.     Application.CutCopyMode = False
  13.     Application.ScreenUpdating = True
  14. End Sub
复制代码
回复

使用道具 举报

发表于 2012-11-23 21:48 | 显示全部楼层    本楼为最佳答案   
本帖最后由 hwc2ycy 于 2012-11-23 21:51 编辑
  1. Sub 插行2()
  2.     Dim rg As Range
  3.     Dim StartRow&, EndRow&, InsertRow&, i&, msg$, Result
  4.     On Error Resume Next
  5.     Do
  6.         Set rg = Application.InputBox("请选择要复制的区域:", , , , , , , 8)
  7.         If rg Is Nothing Then Exit Sub
  8.         StartRow = rg.Row
  9.         EndRow = rg.Rows.Count + StartRow - 1
  10.         InsertRow = Application.InputBox("请输入要复制的行数", , , , , , , 1)
  11.         If InsertRow < =0 Then Exit Sub
  12.         msg = "要复制的区域为:" & rg.Address(False, False) & vbCr & "要复制的行数为:" & InsertRow
  13.         Result = MsgBox(msg, vbOKCancel + vbApplicationModal, "确认!")
  14.     Loop While Result = 2
  15.    
  16.     Application.ScreenUpdating = False
  17.     For i = EndRow + 1 To StartRow - 1 Step -1
  18.         Rows(i - 1).Copy
  19.         Rows(i).Resize(InsertRow).Insert
  20.     Next
  21.     Application.CutCopyMode = False
  22.     Application.ScreenUpdating = True
  23. End Sub
复制代码
改进版,可自由选择区域,及要复制的行数。
回复

使用道具 举报

发表于 2012-11-23 21:51 | 显示全部楼层
批量插入行.gif
回复

使用道具 举报

 楼主| 发表于 2012-11-24 02:01 | 显示全部楼层
非常感谢各位!
感谢管理员同学详尽的解答。学习ing。。。。。。
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 04:20 , Processed in 3.430492 second(s), 12 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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