如果列包含大于 1 的数字，则将该行复制多次

Question

好的，所以我开始工作了，并添加了我的代码以更改同一循环中的另一列，我的最后一个挑战是查看我的 Q 列，其中包含订购项目的数量，如果它 > 1然后复制整行，并将其粘贴到新插入的行中，无论数量超过 1。 示例

Josh   Smith  Soda    1
John   Doe    Banana  3
Tony   Brown  Cake    1 

需要变成

Josh   Smith  Soda    1
John   Doe    Banana  3
John   Doe    Banana  3
John   Doe    Banana  3
Tony   Brown  Cake    1 

到目前为止我的代码是：

Sub prepLabels()
Dim i As Long
For i = 3 To Range("A2").End(xlDown).Row Step 1
    If Cells(i, "Q") > 1 Then
        ActiveCell.EntireRow.Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
    End If
End If
Next i
End Sub

但显然我在某些方面失败了，因为我的第一行只是复制了 7 次左右。

Answer 1

插入行时，始终从底部开始，然后向顶部工作，这样插入的行就不会与您的迭代计数冲突。

Sub prepLabels()
    Dim i As Long, r As Long, lr As Long
    With ActiveSheet   'define this worksheet properly!
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = lr To 3 Step -1
            For r = 2 To .Cells(i, "Q").Value2
                .Cells(i + 1, 1).EntireRow.Insert
                .Cells(i, 1).Resize(2, Columns.Count).FillDown
            Next r
        Next i
    End With
End Sub