Excel 宏/VBA - 复制选定的行并添加重复值

Question

我正在尝试自动化一些繁琐的工作任务，即复制选定的行，然后在每个行中添加一个额外的值，但我被困在后面的部分。

正如您在下面看到的，我可以复制我选择的行，但是当我去添加一个并发值时，偏移量不会对齐。

理想情况下，我会让它复制行，分配一个大小值，然后为每个大小重复该值，然后再转向新样式。

谁能指出我正确的方向？这是我所在的位置：

Dim i As Long

For i = (Selection.Row + Selection.Rows.Count - 1) To Selection.Row Step -1
    Rows(i).Copy
    Range(Rows(i + 1), Rows(i + 1)).Insert Shift:=xlDown

    Rows(i).Copy
    Range(Rows(i + 1), Rows(i + 1)).Insert Shift:=xlDown

    Rows(i).Copy
    Range(Rows(i + 1), Rows(i + 1)).Insert Shift:=xlDown

    Rows(i).Copy
    Range(Rows(i + 1), Rows(i + 1)).Insert Shift:=xlDown

    Rows(i).Copy
    Range(Rows(i + 1), Rows(i + 1)).Insert Shift:=xlDown


     ActiveCell.Offset(1, 2).Range("A1").Select
     ActiveCell.FormulaR1C1 = "X-small"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Small"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Medium"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "Large"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "X-large"
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "XX-Large"


Next i

End Sub

初始数据 Initial Data

当前结果：

期望的结果：

Answer 1

你可以这样做。

所以我使用 Array 函数来填充大小值，然后我们不需要任何虚拟列。

VBA 代码：

Sub RepeatRepeat()

Dim myArrayVal()
Dim i As Long
Dim j As Long
Dim k As Long
Dim lrow As Long
Dim lrow2 As Long

myArrayVal() = Array("X-Small", "Small", "Medium", "Large", "X-Large", "XX-Large")

lrow = Cells(Rows.Count, 1).End(xlUp).Row 'find last row in Column A

j = 2
For j = 2 To lrow
    lrow2 = Cells(Rows.Count, 9).End(xlUp).Row + 1 'Find last row in column I
    For k = LBound(myArrayVal) To UBound(myArrayVal) 'Loop Array
        Cells(lrow2, 9).Value = myArrayVal(k) 'Print Array value
        Cells(lrow2, 8).Value = Cells(j, 2).Value 'Copy from Column B to Column H
        Cells(lrow2, 7).Value = Cells(j, 1).Value 'Copy from Column B to Column H
        lrow2 = lrow2 + 1 'Add one to last row
    Next k
Next j
End Sub

结果：