基于Table1重复项自动插入并填充Excel行的技术求助

核心思路 #

利用VBA宏实现自动化操作：从Sheet2的Table1中提取重复Item No.的基础数据，遍历Sheet1的现有数据，在目标Item No.下方插入指定行数，并用Table1的重复数据填充新行（Qty列留空）。

实现代码 #

Sub InsertDuplicateRows()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim tbl As ListObject
    Dim lastRow1 As Long
    Dim i As Long, j As Long, insertCount As Long
    Dim itemNo As String
    Dim desc As String, binCode As String, uom As String
    Dim matchCell As Range
    
    ' 绑定工作表与Table1
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set tbl = ws2.ListObjects("Table1")
    
    ' 从Sheet1底部向上遍历，避免插入行打乱索引
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    For i = lastRow1 To 2 Step -1 ' 假设第1行为表头
        itemNo = ws1.Cells(i, "A").Value ' Item No.对应Sheet1的A列
        If itemNo <> "" Then
            ' 计算需插入的行数：Table1中该Item No.的总数量 - 1（原行已存在）
            insertCount = Application.WorksheetFunction.CountIf(tbl.ListColumns("Item No.").DataBodyRange, itemNo) - 1
            
            If insertCount > 0 Then
                ' 从Table1中提取该Item No.的基础数据
                With tbl.ListColumns("Item No.").DataBodyRange
                    Set matchCell = .Find(What:=itemNo, LookIn:=xlValues, LookAt:=xlWhole)
                    If Not matchCell Is Nothing Then
                        desc = tbl.ListColumns("Description").DataBodyRange(matchCell.Row - tbl.HeaderRowRange.Row).Value
                        binCode = tbl.ListColumns("Bin Code").DataBodyRange(matchCell.Row - tbl.HeaderRowRange.Row).Value
                        uom = tbl.ListColumns("UOM").DataBodyRange(matchCell.Row - tbl.HeaderRowRange.Row).Value
                    End If
                End With
                
                ' 批量插入目标行数
                ws1.Rows(i + 1 & ":" & i + insertCount).Insert Shift:=xlDown
                
                ' 填充新行数据，Qty列留空
                For j = 1 To insertCount
                    ws1.Cells(i + j, "A").Value = itemNo
                    ws1.Cells(i + j, "B").Value = desc ' Description对应Sheet1的B列
                    ws1.Cells(i + j, "C").Value = binCode ' Bin Code对应Sheet1的C列
                    ws1.Cells(i + j, "D").Value = uom ' UOM对应Sheet1的D列
                    ' Qty列无需赋值，保持为空
                Next j
            End If
        End If
    Next i
End Sub

关键细节说明 #

1. 反向遍历：从Sheet1最后一行往上处理，避免插入行后后续行的索引偏移导致漏处理。
2. 重复行数计算：用CountIf直接统计Table1中目标Item No.的总出现次数，减1即为需要插入的行数（原行已存在）。
3. 数据提取：通过Find定位Table1中该Item No.的第一条记录，提取对应的描述、仓位码和单位信息。
4. 批量插入与填充：先批量插入指定行数，再循环填充数据，提升效率；Qty列不做赋值，自然保持为空。

适配调整提示 #

• 列对应关系：若Sheet1的列位置不同，修改代码中Cells(i, "列号")的列标识。
• 表头行：若Sheet1表头不在第1行，调整For i = lastRow1 To 2 Step -1中的起始行号。
• Table1列名：如果Table1的列名与代码中不一致，修改tbl.ListColumns("列名")中的名称。

使用方法 #

1. 按Alt+F11打开VBA编辑器，右键点击当前工作簿→插入→模块。
2. 将上述代码粘贴到模块中，保存工作簿为.xlsm格式（启用宏）。
3. 直接运行宏，或在Sheet1中添加按钮绑定该宏，手动触发执行。

内容的提问来源于stack exchange，提问作者JMCLEAN