按数量复制行

Question

我想按列中标识的数量复制行。我遇到了这个问题

到目前为止，我已经能够按数量复制行，但无法添加该行的“阻止”

这是数据：enter image description here

预期结果：enter image description here

这是我正在使用的代码。它是另一个代码的调整版本

Sub CopyBlocks（）Dim StartRow，LastRow，NewSheetRow As Long Dim n，i As Integer

Worksheets("test").Activate
LastRow = Cells(Rows.Count, 7).Row
NewSheetRow = 10

For StartRow = 10 To LastRow
n = CInt(Worksheets("test").Range("AA" & StartRow).Value)
For i = 1 To n
    Worksheets("test2").Range("C" & NewSheetRow).Value = Worksheets("test").Range("g" & StartRow).Value
    Worksheets("test2").Range("D" & NewSheetRow).Value = Worksheets("test").Range("H" & StartRow).Value
    Worksheets("test2").Range("E" & NewSheetRow).Value = Worksheets("test").Range("I" & StartRow).Value
    Worksheets("test2").Range("F" & NewSheetRow).Value = Worksheets("test").Range("J" & StartRow).Value
    Worksheets("test2").Range("G" & NewSheetRow).Value = Worksheets("test").Range("K" & StartRow).Value

    NewSheetRow = NewSheetRow + 1
Next i
Next StartRow

结束子

Answer 1

如果您使用的是excel 2016，那么您可以使用PowerQuery非常好地取消此数据集。 Keith在评论中为您提供了非常有用的链接。过滤掉零，你几乎就是你的解决方案。游戏中有一点点复杂性，可能存在重复的行。如果你有兴趣进入M语言的内容，那么List.Numbers函数可以帮助你。

但是，在VBA中解决这个问题并不难。我建议采用一种稍微不同的策略来迭代你的交叉表范围，当你点击计数超过0时，会拔出行和列标题。

Sub foo()

    Dim outputRow As Integer

    'start your output at whatever row is best
    outputRow = 1

    'set your range to cover the counts in your crosstab
    For Each c In Range("A1:Z99")
        If c.Value > 0 Then

            For i = 1 To c.Value

                    'write the values off the current row headers over to comparable positions in your output row
                    Worksheets("test2").Cells(outputRow, 3).Value = Cells(c.Row, 1).Value
                    Worksheets("test2").Cells(outputRow, 4).Value = Cells(c.Row, 2).Value
                    .
                    .
                    .

                    'write the values off the current column headers into output row
                    Worksheets("test2").Cells(outputRow, 8).Value = Cells(1, c.Column).Value

                outputRow = outputRow + 1
            Next i

        End If
    Next c
End Sub

祝你好运，希望它有所帮助