复制选定的行两次
复制选定的行两次
提问于 2015-11-09 13:45:17
我编写了一个非常基本的Excel宏，将选定的行复制两次，然后将光标向下移动3行，以便可以再次重复该过程。
因此，如果我有一个文件，其中前10行都需要重复两次，我运行宏10次。
这已经为我节省了一堆击键，但我确信它会写得更好，所以我只需选择前10行，然后运行宏一次。
到目前为止，我的情况如下：
Sub Copy_Twice()
' Copies current row twice
ActiveCell.EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
ActiveCell.EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
ActiveCell.Offset(rowOffset:=3).Select
End Sub对于我运行这个宏的每个文件，它可能不是要复制的第10行。
实际上，如果J列中的单元格为空，则更好的宏是复制每一行两次。
Update:文件有一个标头行，其值为A至X列。要复制的行将是标题之后的第一个x#行，其中J列为空。因此，在一个例子中，第2-11行需要重复两次。但在另一个文件中，可能是第2-21行。
回答 3
Stack Overflow用户
回答已采纳
发布于 2015-11-09 13:59:08
试试这个：
Dim n&, x&
n = 0
x = Application.WorksheetFunction.CountIf(Range("J:J"), " ")
Range("A2").Select
While n <> x
ActiveCell.EntireRow.Copy: ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.EntireRow.Copy: ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.Offset(3, 0).Select
n = n + 1
Wend
Application.CutCopyMode = False
End SubStack Overflow用户
发布于 2015-11-09 14:13:49
下面是一些允许用户输入行计数的代码，并测试每一行的J列是否为空：
Sub CopyRows()
Dim x As Integer
x = InputBox("How Many Rows to Copy?", 8)
Dim c As Range
Set c = Range("A2")
Dim y As Integer
For y = x to c.Row Step -1
If IsEmpty(Cells(y, "J")) Then
Cells(y,1).EntireRow.Copy: Cells(y,1).Resize(2,1).EntireRow.Insert Shift:=xlDown
End If
Next
End SubStack Overflow用户
发布于 2015-11-09 15:56:12
如果可以依赖列A来显示要处理的行的范围，那么在A列中找到最后填充的行并向第2行工作应该涵盖所有要处理的行。
Sub add_Duplicate_Blank_Js()
Dim rw As Long
With Worksheets("Sheet4")
With .Cells(1, 1).CurrentRegion
For rw = .Rows.Count To 2 Step -1
If Not CBool(Len(.Cells(rw, "J"))) Then
With .Rows(rw).Cells
.Copy
.Resize(2, .Columns.Count).Insert Shift:=xlDown
End With
End If
Next rw
Application.CutCopyMode = False
End With
End With
End Sub将标题填充到数据的整个范围，从底部到顶部(在下一次声明中插入或删除行时建议在Range.CurrentRegion性质中插入或删除行)。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/33610534
复制相关文章
相似问题
腾讯云开发者
