Копировать строки в Excel и увеличить столбец

Question

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

Также это увеличило бы одно из чисел в ячейке. Например, у меня есть макет, подобный следующему:

Column1    Column2    Column3     Column4, etc..  
Data-a     Data-a     1000        5  
Data-b     Data-b     4600        10  

Результат будет:

Column1    Column2    Column3     Column4  
Data-a     Data-a     1000        5  
Data-a     Data-a     1001        5  
Data-a     Data-a     1002        5  
Data-a     Data-a     1003        5  
Data-a     Data-a     1004        5  
Data-b     Data-b     4600        10  
Data-b     Data-b     4601        10  
Data-b     Data-b     4602        10  
Data-b     Data-b     4603        10  
Data-b     Data-b     4604        10  
Data-b     Data-b     4605        10  
Data-b     Data-b     4606        10  
Data-b     Data-b     4607        10  
Data-b     Data-b     4608        10   
Data-b     Data-b     4609        10  

Надеюсь, это имеет смысл. Я ищу кого-то, кто может быть немного более сведущ в этом типе макросов, чтобы пролить свет или указать мне правильное направление.

Answer 1

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

Существует три процедуры:

1. InsertNewRows: просто вставляется необходимое количество пустых новых строк
2. ReplicateData: заполняет пустые строки правильными данными
3. TransformData: это основная процедура, которая проходит по каждой строке, для которой требуется репликация

---

Sub InsertNewRows(TargetRow As Integer, TargetCol As Integer, Reps As Integer)
    Dim iRep As Integer
    For iRep = 1 To Reps - 1
        Cells(TargetRow + iRep, TargetCol).EntireRow.Insert Shift:=xlDown
    Next iRep
End Sub

---

Sub ReplicateData(TargetRow As Integer, TargetCol As Integer, Reps As Integer)
Dim iRep As Integer
    For iRep = 1 To Reps - 1
        With Cells(TargetRow, TargetCol)
            .Offset(iRep, 0).Value = .Value
            .Offset(iRep, 1).Value = .Offset(0, 1).Value
            .Offset(iRep, 2).Value = .Offset(0, 2).Value + iRep
            .Offset(iRep, 3).Value = .Offset(0, 3).Value
        End With
    Next iRep
End Sub

---

Sub TransformData()
Dim nRows As Long

nRows = ActiveCell.CurrentRegion.Rows.Count

Dim StartingRow As Integer
Dim StartingColumn As Integer
Dim NumberOfReplications As Integer
Dim RowOffset

StartingRow = ActiveCell.Row
StartingColumn = ActiveCell.Column
NumberOfReplications = 0
RowOffset = 0

Dim iIterations As Integer

For iIterations = 1 To nRows

If Not VBA.IsEmpty(Cells(StartingRow + RowOffset, StartingColumn)) Then
   NumberOfReplications = Cells(StartingRow + RowOffset, StartingColumn).Offset(0, 3)
   InsertNewRows StartingRow + RowOffset, StartingColumn, NumberOfReplications
   ReplicateData StartingRow + RowOffset, StartingColumn, NumberOfReplications
   RowOffset = RowOffset + NumberOfReplications
End If

Next iIterations

End Sub