Vba Excel在工作表中循环为父项创建新行

我需要一些帮助来创建一个简单的VBA，以便为带有变量的项目列表创建父行

我的截图

如屏幕截图所示，目前我的数据与“之前”表类似。我正在尝试创建一个VBA脚本，该脚本在所有行中循环，并基于组创建新行。我想为每个组号创建一个新行，在新行上，它从下面的单元格复制某些值

谢谢！ 尼尔森

试试这个：

Sub Add_Row()

Range("I3").Select 'This assumes the first row of data after column headers is row 3

While ActiveCell <> ""

If ActiveCell.Offset(0, 1).Value <> "" Then

Selection.EntireRow.Insert

ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(1, 1).Value
ActiveCell.Offset(1, 1).ClearContents
ActiveCell.Offset(0, -3).Value = ActiveCell.Offset(1, -3).Value
ActiveCell.Offset(0, -4).Value = ActiveCell.Offset(1, -4).Value & "P"

ActiveCell.Offset(1, 0).Select

Else

ActiveCell.Offset(1, 0).Select

End If

Wend

Range("A1").Select

End Sub

子添加_行（）
范围（“I3”）。选择“这假设列标题后的第一行数据是第3行
而ActiveCell“”
如果ActiveCell.Offset（0，1）.Value为“”，则
Selection.EntireRow.Insert
ActiveCell.Offset（0，1）.Value=ActiveCell.Offset（1，1）.Value
ActiveCell.Offset（1，1）.ClearContents
ActiveCell.Offset（0，-3）.Value=ActiveCell.Offset（1，-3）.Value
ActiveCell.Offset（0，-4）.Value=ActiveCell.Offset（1，-4）.Value&“P”
ActiveCell.Offset（1，0）。选择
其他的
ActiveCell.Offset（1，0）。选择
如果结束
温德
范围（“A1”）。选择
端接头

您可以像这样插入空行：

Sub Macro1()
    Dim i As Long
    i = 3    

    Do While Cells(i, 1) <> ""
      If Cells(i, 1) <> Cells(i - 1, 1) Then
        Rows(i).Insert Shift:=xlDown
        i = i + 1
      End If
      i = i + 1
    Loop
End Sub

Sub宏1（）
我想我会坚持多久
i=3
“当单元格（i，1）”时执行”
如果单元格（i，1）单元格（i-1，1），那么
行（i）.插入移位：=xlDown
i=i+1
如果结束
i=i+1
环
端接头

---

希望更改单元格现在不成问题

下面的代码可以让您轻松地将其更改为您当前和未来的需要

根据链接的示例，我假设“Description”列在每个“Group”或“SKU”行块的开头总是有一个非空单元格

Sub CreateRowForParentItem()

Dim sht As Worksheet
Dim cell As Range
Dim descriptionCol As Long, SKUCol As Long, productCol As Long

'------------------------------
' setting stuff - begin
descriptionCol = 10 '<== adapt it to your actual "Description" column number
SKUCol = 5          '<== adapt it to your actual "SKU" column number
productCol = 6      '<== adapt it to your actual "Product Title" column number

Set sht = ThisWorkbook.Sheets("SheetFruit") '<== change 'data' sheet as per your needs
' setting stuff - end
'------------------------------


'------------------------------
' core code - begin
With sht
    Set cell = .Cells(.Rows.Count, descriptionCol).End(xlUp) '<== find last non blank cell in "Description" column
    Do While cell.value <> "Description" '<== proceed only if it's not the header cell
        cell.EntireRow.Insert
        Call CopyAndClearRange(.Cells(cell.row, SKUCol))
        Call CopyAndClearRange(.Cells(cell.row, productCol))
        Call CopyAndClearRange(.Cells(cell.row, descriptionCol), True)

        Set cell = .Cells(cell.row - 1, descriptionCol).End(xlUp) '<== find next non blank cell up
    Loop
End With
' core code - end
'------------------------------

End Sub


Sub CopyAndClearRange(rng As Range, Optional okClear As Variant)

If IsMissing(okClear) Then okClear = False
With rng
    .Copy .Offset(-1)
    If okClear Then .Clear
End With

End Sub

子CreateRowForParentItem（）
将sht变暗为工作表
暗淡单元格作为范围
暗淡的描述颜色为长、SKUCol为长、productCol为长
'------------------------------
'设置内容-开始
descriptionCol=10'您可以生成一段代码，在工作表中迭代，在“J”列中查找文本。找到后，在上面插入一行并将文本移动到那里。您可以使用这个：和这个：首先您需要对名为SKU的列进行排序，然后在vba代码中进行排序，如果e3=24，则进行while循环，然后“不做任何事情”插入新行并将p添加到SKU代码中。希望它是清楚的