1

我有一个看起来像这样的 excel 文件：
row1_cell1 row1_cell2 row1_cell3
row2_cell1 row2_cell2 row2_cell3
row3_cell1 row3_cell2 row3_cell3

我如何制作工作表中每一行的三个（或任意数量）副本，我想在复制行之后添加这些副本？So, in the end i would like to have this kind of a result:
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

4

3 回答 3

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
于 2012-06-29T13:50:04.617 回答
0

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

例如，您可以：-

  1. 在 Excel 文件中创建一个 VBA 过程（如下所示）。
  2. 为其分配键盘快捷键（例如 Ctrl+Q）。
    • 为此，请按 Alt+F8，然后选择宏，然后单击“选项”。
  3. 选择要复制的单元格，然后按 Ctrl+C。
  4. 选择要粘贴的单元格，然后按 Ctrl+Q（或您选择的任何键盘快捷键）。
  5. 输入要复制的次数。（在您的示例中，它将是 3。）
  6. 哇！:D
  7. 现在您可以删除 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
于 2012-06-29T06:41:03.960 回答
0

旧线程，但有人可能会觉得这很有用：以下信息是从这里复制的

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

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

该信息在“J”列中。

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

希望有人觉得这很有用。我一直在寻找这个解决方案，但今天我真的需要它。谢谢。

于 2019-11-04T05:09:02.753 回答