дублирование строк по количеству

Question

Я хотел бы дублировать строки на количество, указанное в столбцах. у меня проблемы с этим

До сих пор я был в состоянии продублировать строки по количеству, но не смог добавить, какой «Блок» предназначен для этой строки

это данные: введите описание изображения здесь

ожидаемый результат: введите описание изображения здесь

это код, который я использую. это исправленная версия другого кода

Sub CopyBlocks () Dim StartRow, LastRow, NewSheetRow As Long Дим н, я как целое число

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

End Sub

Answer 1

Если вы используете Excel 2016, то вы можете использовать PowerQuery для очень удобного удаления этого набора данных.Кит имеет очень полезную ссылку для вас в комментариях.Отфильтруйте нули, и вы почти в своем решении.Небольшая сложность входит в игру с возможностью повторения этих строк.Функция 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

Удачи, надеюсь, этопомогает