如何用VBA根据单元格数值n插入复制对应行数并跨表生成数据

以下代码适配你的「新工作表生成单单位单行数据」需求，不会修改原始清单内容，可直接使用：

Sub 按数量拆分物品清单()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRow As Long, targetRow As Long, i As Long, j As Long, qty As Long
    Dim itemName As String
    
    ' ===== 可根据实际表格修改以下配置参数 =====
    Set wsSource = ThisWorkbook.Worksheets("原始清单") ' 替换为你的源工作表实际名称
    Const itemCol As String = "A" ' 物品名称所在列标
    Const qtyCol As String = "B" ' 数量所在列标
    Const headerRow As Long = 1 ' 表头所在行号
    ' ==========================================
    
    ' 新建目标工作表存放拆分结果
    Set wsTarget = ThisWorkbook.Worksheets.Add(after:=wsSource)
    wsTarget.Name = "拆分后清单"
    
    ' 复制表头到目标表
    wsSource.Rows(headerRow).Copy wsTarget.Rows(1)
    targetRow = 2 ' 目标表从第2行开始写入拆分后数据
    
    ' 遍历源表所有有效数据行
    lastRow = wsSource.Cells(wsSource.Rows.Count, itemCol).End(xlUp).Row
    For i = headerRow + 1 To lastRow
        itemName = wsSource.Cells(i, itemCol).Value
        qty = Val(wsSource.Cells(i, qtyCol).Value)
        ' 跳过物品名为空、数量小于等于0的无效行
        If qty > 0 And itemName <> "" Then
            ' 按数量值循环，逐行写入单单位数据
            For j = 1 To qty
                wsTarget.Cells(targetRow, itemCol).Value = itemName
                wsTarget.Cells(targetRow, qtyCol).Value = 1 ' 每行对应1单位数量
                ' 若有其他列需要同步复制，在此处添加对应语句即可，示例：
                ' wsTarget.Cells(targetRow, "C").Value = wsSource.Cells(i, "C").Value
                ' wsTarget.Cells(targetRow, "D").Value = wsSource.Cells(i, "D").Value
                targetRow = targetRow + 1
            Next j
        End If
    Next i
    
    MsgBox "拆分完成，结果已生成在【" & wsTarget.Name & "】工作表"
End Sub

疑问答复 #

• 代码中出现的"A"、"B"、"C"不是已定义的命名区域，是VBA中通用的列标识写法，直接对应工作表的A列、B列、C列，你可以根据自身表格的实际列位置替换为对应列标。
• Gary's Student给出的原版代码是在源表直接插入行，如果源表处于筛选状态，会因为行号定位偏移出现报错、数据错位问题，无法正常运行。上述适配版代码直接读取单元格底层存储值遍历，不受筛选状态、隐藏行影响，筛选状态下也能正常读取所有有效数据完成拆分。

使用提示 #

• 运行代码前请先修改配置参数段的内容，匹配你自己的表格结构。
• 如果源表存在多个需要同步拆分的属性列，参照代码注释里的示例补充列复制语句即可，所有属性会同步匹配到每一行拆分后的数据中。
• 首次运行前建议备份原始文件，避免误操作导致数据丢失。

内容的提问来源于stack exchange，提问作者Alfred E Neuman