VBA实现Excel超千条行内多商品数据按条目拆分转置

操作前注意 #

• 先完整备份原始数据表，避免代码运行异常导致数据丢失
• 确保你的原始数据第一行是表头，有效数据从第2行开始，A列是序号、B列是姓名、C到V列是商品数据

实现步骤 #

1. 打开目标Excel文件，按Alt+F11调出VBA编辑器
2. 右键点击左侧项目栏中的当前工作簿名称，选择「插入」-「模块」
3. 将下方代码粘贴到模块编辑区域，按F5运行即可

Sub 拆分商品到多行()
    Dim lastRow As Long, i As Long, j As Long, insertCount As Long
    ' 获取当前工作表最后一行有效数据的行号
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    ' 从最后一行往上遍历，避免插入行导致的行号错乱
    For i = lastRow To 2 Step -1
        ' 统计当前行非空的商品数量（C到V列共20列）
        insertCount = Application.WorksheetFunction.CountA(Range("C" & i & ":V" & i))
        ' 商品数大于1时插入对应行数
        If insertCount > 1 Then
            Rows(i + 1 & ":" & i + insertCount - 1).Insert
            ' 新插入行填充相同姓名
            Range("B" & i & ":B" & i + insertCount - 1).Value = Range("B" & i).Value
            ' 同用户仅第一行保留序号，后续行留空
            Range("A" & i + 1 & ":A" & i + insertCount - 1).Value = ""
            ' 逐个把商品填充到每行第三列
            For j = 1 To insertCount
                Cells(i + j - 1, "C").Value = Cells(i, 2 + j).Value
            Next j
        End If
    Next i
    ' 自动删除多余的商品列，生成最终三列结构
    Columns("D:V").Delete
    ' 修改第三列表头为要求的Items
    Range("C1").Value = "Items"
    MsgBox "拆分完成！"
End Sub

效果说明 #

代码运行后会直接在原表生成你需要的结构，1000+条数据可在几秒内处理完成，空白的商品单元格会自动跳过不会生成空行。

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