根据单元格值重复行“x”次数答案

【问题标题】：duplicate row “x” number of times based on cell value根据单元格值重复行“x”次数
【发布时间】：2017-09-23 11:50:17
【问题描述】：

我正在尝试根据工作表 1 的 H 列中指示的值将工作表 1 中的行复制到工作表 2 上。

我发现了一个似乎有效的代码，但它更改了原始工作表中的数据，而不是将行复制到不同的工作表中，例如“Sheet2”。

Sub CopyData()
'Updateby Extendoffice 20160922
    Dim xRow As Long
    Dim VInSertNum As Variant
    xRow = 1
    Application.ScreenUpdating = False
    Do While (Cells(xRow, "A") <> "")
        VInSertNum = Cells(xRow, "H")
        If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
           Range(Cells(xRow, "A"), Cells(xRow, "H")).Copy
           Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "H")).Select
           Selection.Insert Shift:=xlDown
           xRow = xRow + VInSertNum - 1
        End If
        xRow = xRow + 1
    Loop
    Application.ScreenUpdating = False
End Sub

如果 H 列中的值大于 0，如何更改此代码以运行原始提取工作表“Sheet1”中的宏并将行复制到“Sheet2”中？

Sheet1 中的示例数据如下。容器中的值在 H 列中，它决定了要复制并复制到 Sheet2 中的行数。

Supplier    Dest    Code     Quantity Container
A           US01    10001    1000     2
A           US02    10002    500      4
B           UK01    10001    0        0
C           US01    10004    1300     1

Sheet2 中想要的结果如下：

Supplier    Dest    Code     Quantity Container
A           US01    10001    1000     2
A           US01    10001    1000     2    
A           US02    10002    500      4
A           US02    10002    500      4
A           US02    10002    500      4
A           US02    10002    500      4
C           US01    10004    1300     1

谢谢。

【问题讨论】：

r 是什么？你在哪里定义 ans Set 它？它应该是Range 吗？
我在这方面真的很陌生。这是我从上面提到的链接中复制的代码。我不确定它应该是什么意思。
您从一个答案复制了一点，从另一个答案复制了另一部分。您要查找的“H”列中的值是多少，以便将其复制到“Sheet”1
当 H 列的值大于 1 时，您希望将数据从 sheet1 复制到 sheet2。对吧？
大于零。如果值为0，则该行不会被复制到sheet2 如果H 中的值为1，则该行数据被复制到sheet2 中一次。如果H中的值为2，则将该行数据复制两次到sheet2中。

标签： vba excel

【解决方案1】：

我知道这个问题很老，但没有答案，所以我认为可以提交一个。

我制作了一个新的宏，我认为它会更简单、更易于阅读和理解。如果您以后需要更改，所有这些都将使您更容易编辑。

据我了解，您在 D 列到 H 列中有您想要复制 x 次的信息；其中 x 是 H 列中的一个值。我假设您的工作表被命名为“Sheet1”和“Sheet2”。我在下面提供了答案。

Dim wsc As Worksheet 'worksheet copy
Dim wsd As Worksheet 'worksheet destination

Dim lrow As Long 'last row of worksheet copy
Dim crow As Long 'copy row
Dim drow As Long 'destination row

Dim multiplier As Integer
Dim i As Integer 'counting variable for the multiplier

Set wsc = Sheets("Sheet1")
Set wsd = Sheets("Sheet2")

lrow = wsc.Range("h" & wsc.Rows.Count).End(xlUp).row
drow = 2

With wsc

    For crow = 2 To lrow 'starts at 2 because of the header row

        multiplier = .Cells(crow, 8).Value 'copies the value in column h

        For i = 1 To multiplier

            wsd.Cells(drow, 4).Value = .Cells(crow, 4).Value
            wsd.Cells(drow, 5).Value = .Cells(crow, 5).Value
            wsd.Cells(drow, 6).Value = .Cells(crow, 6).Value
            wsd.Cells(drow, 7).Value = .Cells(crow, 7).Value
            wsd.Cells(drow, 8).Value = .Cells(crow, 8).Value

            drow = drow + 1 'increasing the row in worksheet destination 

        Next i

    Next crow

End With

如果有任何方法可以改进此答案，请告诉我！ :)

【讨论】：