Question

我有一个excel文件，如下所示：
row1_cell1 row1_cell2 row1_cell3
row2_cell1 row2_cell2 row2_cell3
row3_cell1 row3_cell2 row3_cell3

如何制作工作表中每行的三个（或任意数量）副本，我希望在复制行后添加这些副本？所以，最后我想得到这样的结果：
row1_cell1 row1_cell2 row1_cell3
row1_cell1 row1_cell2 row1_cell3
row1_cell1 row1_cell2 row1_cell3
row2_cell1 row2_cell2 row2_cell3
row2_cell1 row2_cell2 row2_cell3
row2_cell1 row2_cell2 row2_cell3
row3_cell1 row3_cell2 row3_cell3
row3_cell1 row3_cell2 row3_cell3
row3_cell1 row3_cell2 row3_cell3

Answer 1

这就是我对表单上所有行的操作方式：

Option Explicit

Sub MultiplyRows()
Dim RwsCnt As Long, LR As Long, InsRw As Long

RwsCnt = Application.InputBox("How many copies of each row should be inserted?", "Insert Count", 2, Type:=1)    
If RwsCnt = 0 Then Exit Sub
LR = Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
For InsRw = LR To 1 Step -1
    Rows(InsRw).Copy
    Rows(InsRw + 1).Resize(RwsCnt).Insert xlShiftDown
Next InsRw
Application.ScreenUpdating = True

End Sub

Answer 2

没有直接的方式将它们交错粘贴，就像你想要的那样。但是，您可以创建临时VBA来执行您想要的操作。

例如，您可以： -

在Excel文件中创建一个VBA程序（如下所示）。
为其指定键盘快捷键（例如Ctrl + Q）。
- 要执行此操作，请按Alt + F8，然后选择宏，然后单击“选项”。
选择要复制的单元格，然后按Ctrl + C.
选择要粘贴的单元格，然后按Ctrl + Q（或您选择的任何键盘快捷键）。
输入您要复制的次数。（在你的例子中，它将是3。）
WHAMMO！：d
现在您可以删除VBA过程。：）

VBA代码：

Sub PasteAsInterleave()
    Dim startCell As Range
    Dim endCell As Range
    Dim firstRow As Range
    Dim pasteCount As Long
    Dim rowCount As Long
    Dim colCount As Long
    Dim i As Long
    Dim j As Long
    Dim inputValue As String

    If Application.CutCopyMode = False Then Exit Sub

    'Get number of times to copy.
    inputValue = InputBox("Enter number of times to paste interleaved:", _
                 "Paste Interleave", "")
    If inputValue = "" Then Exit Sub  'Cancelled by user.

On Error GoTo Error
    pasteCount = CInt(inputValue)
    If pasteCount <= 0 Then Exit Sub
On Error GoTo 0

    'Paste first set.
    ActiveSheet.Paste
    If pasteCount = 1 Then Exit Sub

    'Get pasted data information.
    Set startCell = Selection.Cells(1)
    Set endCell = Selection.Cells(Selection.Cells.count)
    rowCount = endCell.Row - startCell.Row + 1
    colCount = endCell.Column - startCell.Column + 1
    Set firstRow = Range(startCell, startCell.Offset(0, colCount - 1))

    'Paste everything else while rearranging rows.
    For i = rowCount To 1 Step -1
        firstRow.Offset(i - 1, 0).Copy

        For j = 1 To pasteCount
            startCell.Offset(pasteCount * i - j, 0).PasteSpecial
        Next j
    Next i

    'Select the pasted cells.
    Application.CutCopyMode = False
    Range(startCell, startCell.Offset(rowCount * pasteCount - 1, colCount - 1)).Select
    Exit Sub

Error:
    MsgBox "Invalid number."
End Sub

Answer 3

旧线程，但是有人可能会发现这很有用：以下信息是从here

复制而来的

我需要做几乎相反的事情。我需要使公式每22行增加1，而将21行之间留空。我对上面的公式进行了修改，效果很好。这是我用的：

=IFERROR(INDIRECT("J"&((ROW()-1)*1/22)+1),"")

该信息在“ J”列中。

“ IFERROR”部分处理当结果行计算不是整数时收到的错误，并在该单元格中放置一个空白。

希望有人觉得这很有用。我一直在寻找这种解决方案已有一段时间，但是今天我确实需要它。谢谢。

如何在Excel中自动复制行？

3 个答案: