excel - 如何复制行

Question

我想将工作表中的每一行每行复制 57 次，跨越 39 列(在结果之后，意味着每条记录将有 58 次重复)。

因此，例如，我在下面包含了我的一些记录现在的样子的片段(请记住，有 39 列，片段无法截取完整 View ):

这是我正在寻找的结果(注意:此示例每行有 10 个重复项，而不是 58 个，因为屏幕截图会太大)。原始文件有超过 5000 条记录，所以我知道我使用的任何代码都需要一段时间才能加载，这对我来说很好，我只想要结果)

这是我在下面使用的代码，这不会复制行本身，但会确保每行在 39 列(A 到 AM)的每一行之间有 57 个空白行的间隙。这将是完成任务的一种更长、更复杂的方法，因为我必须找到一种方法来填补空白。因此，为什么我要发布这个问题，因为必须有更有效的方法。

Sub Duplication()

Dim lastRow As Long
lastRow = Sheets("MasterSheet").Range("A" & Rows.Count).End(xlUp).Row

For i = lastRow To 3 Step -1
    Cells(i, 1).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 2).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 3).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 4).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 5).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 6).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 7).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 8).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 9).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 10).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 11).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 12).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 13).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 14).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 15).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 16).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 17).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 18).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 19).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 20).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 21).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 22).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 23).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 24).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 25).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 26).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 27).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 28).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 29).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 30).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 31).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 32).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 33).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 34).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 35).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 36).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 37).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 38).Resize(57).Insert Shift:=xlDown
Next
For i = lastRow To 3 Step -1
    Cells(i, 39).Resize(57).Insert Shift:=xlDown
Next    

End Sub

请让我知道您的想法，如果有我目前不知道的更简单的解决方案，我们深表歉意。我尝试查看论坛和其他问题，但我所显示的代码中没有一个给我提供了所需方向的结果。

谢谢

Answer 1

您可以将所有数据放入数组并从那里循环粘贴值:

Sub test()
Dim i As Long, j As Long
Dim LastColumn As Long, LastRow As Long
Dim MyData As Variant
Dim HowManyCopies As Long, MyCounter As Long, CurrentRow As Long

Application.ScreenUpdating = False

'get last column, in your case 39, here is just 4
LastColumn = 4

'get last non blank row
LastRow = Range("A" & Rows.Count).End(xlUp).Row

'all data into array, headers included
MyData = Range("A1").CurrentRegion.Value

'clear range except headers
Range(Cells(2, 1), Cells(LastRow, LastColumn)).Clear

'Duplicate rows. Loop trough each row of array
'we start at row 2 because 1 is headers

HowManyCopies = 4 'as example, just 4 duplicates of each row
CurrentRow = 2 'where to start duplicating

For i = 2 To UBound(MyData) Step 1
    'loop trough counter until HowManyCopies is reached
    For MyCounter = 1 To HowManyCopies Step 1
        'loop trough each column and paste value
        For j = 1 To LastColumn Step 1
            Cells(CurrentRow, j).Value = MyData(i, j)
        Next j
        CurrentRow = CurrentRow + 1
    Next MyCounter
Next i

Erase MyData 'clean variable

Application.ScreenUpdating = True
End Sub

上面的示例只是将每行 5 行 4 列的数据集复制了 4 次，但很容易适应 5000 行 39 列(这将花费更长的时间，困难)。