Добавить строки и дублировать данные установленное количество раз

Question

Я пытаюсь написать макрос VBA Excel для просмотра сотен тысяч строк данных, чтобы убедиться, что каждая уникальная запись в столбце A имеет количество записей, равное столбцу C.

Например:

Идентификатор исходного счета 84512 встречается 6 раз, но должно быть 12 вхождений (как указано в столбце C). Это означает, что мне нужно добавить 6 строк до (или после) существующих 6 строк.

Далее мы видим, что идентификатор исходного аккаунта 64857 встречается один раз, но должен произойти 5 раз Я бы добавил 4 строки выше и имел бы тот же код идентификатора исходной учетной записи и то же имя учетной записи. Остальные ячейки могут быть "0".

Вот пример готового продукта:

Вот что у меня есть:

Sub InsertRowAtChangeInValue()
   Dim lRow As Long
   Dim nMonths As Long
   
   For lRow = Cells(Cells.Rows.count, "A").End(xlUp).Row To 2 Step -1
    nMonths = 12 - Cells(Application.ActiveCell.Row, 3).Value
      If Cells(lRow, "A") <> Cells(lRow - 1, "A") Then Rows(lRow).EntireRow.Resize(nMonths).Insert
   Next lRow
End Sub

Пожалуйста, дайте мне знать, если у вас есть какие-либо предложения.

* Все данные в этих примерах вымышлены

Answer 1

Попробуйте сделать это после переименования указанного листа.

Sub expandMonths()
    'https://stackoverflow.com/questions/52304181
    Dim i As Long, j As Long, m As Long, a As Variant

    With Worksheets("sheet1")

        i = .Cells(.Rows.Count, "A").End(xlUp).Row
        Do While i > 1
            a = Array(.Cells(i, "A").Value2, .Cells(i, "B").Value2, 0, 0, 0, 0)
            m = .Cells(i, "C").Value2
            j = Application.Match(.Cells(i, "A").Value2, .Columns("A"), 0)

            If i - j < m Then
                .Rows(j).Resize(m - (i - j) - 1, 1).EntireRow.Insert
                .Cells(j, "A").Resize(m - (i - j) - 1, UBound(a) + 1) = a
                .Cells(j, "C").Resize(m - (i - j) - 1, 4).NumberFormat = "0"
            End If

            i = j - 1
        Loop
    End With

End Sub