VBA для автоматического увеличения номера строки в новый столбец в Excel

Question

У меня есть существующий скрипт, который делает большую часть того, что мне нужно. Сценарий (отсюда: https://www.extendoffice.com/documents/excel/4054-excel-duplicate-rows-based-on-cell-value.html) в основном вставляет, а затем копирует строки данных X количество раз, где X - одно из полей в таблице. Он работает хорошо, и на странице, на которую ссылаются, приведены примеры начала и конца баллы.

Но когда я запускаю скрипт в Excel, я иду от ~ 2000 строк в моей таблице до ~ 40000 строк. Мне нужно изменить все дублированные строки (инкрементные даты), и поэтому я пытаюсь включить новые данные в таблицу во время выполнения сценария, который позволит мне изменять данные в дублированных строках ... например, я могу использовать дубликаты цифр 1, 2, 3, 4 и некоторые простые формулы для изменения дат относительно начальной точки.

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

Имея ноль фактических навыков VBA, я не знаю, как решить вторую часть моей проблемы с помощью кода, который у меня уже есть. Любая помощь была бы просто потрясающей !!

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, "D")
        If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
           Range(Cells(xRow, "A"), Cells(xRow, "D")).Copy
           Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "D")).Select
           Selection.Insert Shift:=xlDown
           xRow = xRow + VInSertNum - 1
        End If
        xRow = xRow + 1
    Loop
    Application.ScreenUpdating = False
End Sub

Answer 1

Попробуйте этот код ниже, я использовал те же примеры данных по ссылке, которую вы предоставили.Однако в этом коде я создал 2 рабочих листа, один для необработанных данных, которые нужно обработать, и один для дублированного вывода, включая приращение дат и повторяющегося числа.

Sub duplicateData()

Dim rSH As Worksheet
Set rSH = ThisWorkbook.Sheets("RAW") 'Your raw data
Dim oSH As Worksheet
Set oSH = ThisWorkbook.Sheets("OUTPUT") 'Output data on another sheet

x = 2
For a = 2 To rSH.Range("A" & Rows.Count).End(xlUp).Row
    For b = 1 To rSH.Cells(a, 4).Value '4 is the column of duplicate times
        If b = 1 Then
            For c = 1 To 4 'Number of your column
                oSH.Cells(x, c).Value = rSH.Cells(a, c).Value
            Next c
            oSH.Cells(x, 5) = 1 'First instance, 5 is the column number of duplicate counter
        Else
            For c = 1 To 4 'Number of your column
                oSH.Cells(x, c).Value = rSH.Cells(a, c).Value
            Next c
            oSH.Cells(x, 3).Value = CDate(oSH.Cells(x - 1, 3).Value) + 1 '3 is the column number of date to increment
            oSH.Cells(x, 5).Value = CInt(oSH.Cells(x - 1, 5).Value) + 1 '5 is the column number of duplicate counter
        End If
        x = x + 1 'Increment Output row number
    Next b
Next a
End Sub