在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

我测试此代码，它似乎工作确定。为了完成这项工作，您需要在数据的初始列表中选择'Data-a'，即左上角的单元格。

有三个步骤：

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