如何在Excel中自動創建行的副本？

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

沒有直接的方法將它們粘貼到你想要的任何位置。但是，您可以創建一個臨時VBA來執行您想要的操作。

例如，您可以： -

1. 在Excel文件中創建一個VBA程序（類似下面）。
2. 給它指定一個鍵盤快捷鍵（例如Ctrl + Q）。
   • 爲此，請按Alt + F8，然後選擇宏，然後單擊'選項'。
3. 選擇要複製的單元格，然後按Ctrl + C。
4. 選擇您想要粘貼的單元格，然後按Ctrl + Q（或您選擇的任何鍵盤快捷鍵）。
5. 輸入您想要複製的次數。 （在你的例子中，它會是3.）
6. WHAMMO！ ：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 

Answer 2

這是我會怎麼做，對於所有行的表上：（？VBA）

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