到目前为止,我已经能够按数量复制行,但是无法添加该行用于哪个“块”
这是数据: enter image description here
预期结果: enter image description here
这是我正在使用的代码。这是另一个代码的调整版本
Sub CopyBlocks() 昏暗的StartRow,LastRow,NewSheetRow 昏暗,我为整数
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
结束子
答案 0 :(得分:0)
如果您使用的是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
祝你好运,希望对你有帮助