Question

我写了一个非常基本的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中的单元格为空，则更好的宏将复制每一行两次。

更新：文件有一个标题行，其中包含A到X列的值。要复制的行将是标题，其中列J为空白后的第一行x＃。因此，在一个示例中，行2-11需要被复制两次。但在另一个文件中，它可能是第2-21行。

Answer 1

我也可以玩吗？：P

这是最快的方法。假设您的数据来自单元格A1:A10。只需运行此代码即可。

您不必使用复制/粘贴。

此代码的作用是，插入空白行，然后模拟 Ctrl + G - ＆gt;特别 - ＆gt;空白单元 - ＆gt;使用 CTRL + ENTER 填充上面一行数据的空白单元格。

For i = 10 To 2 Step -1
    Rows(i).Insert: Rows(i).Insert
Next i

'~~> After the blank rows are inserted your range will
'~~> expand up to row 30
Range("A1:A30").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
Range("A1:A30").Value = Range("A1:A30").Value '<~~ Convert formuals back to values

Answer 2

试试这个：

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 Sub

Answer 3

以下是一些代码，允许用户输入行数并测试每行的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 Sub

Answer 4

如果可以依赖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

当第一行和第A列的标题填充到数据的完整范围时，上面将从底部向后移动（在For Next Statement中插入或删除行时建议） Range.CurrentRegion property。

复制选定的行两次

4 个答案: