如何使用Excel VBA拆分带分隔符的列并展开表格？

刚好我之前也碰到过一模一样的需求，用VBA来实现这种拆分其实挺简单的，给你分享两种实用的方案，按需选择就行：

方法1：基础循环拆分（适合小数据量） #

这个方法逻辑直观，逐行处理每个单元格，把拆分后的内容逐行插入：

Sub SplitItemsToRows()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim splitItems As Variant
    
    ' 设置要处理的工作表，这里用当前激活的工作表，也可以改成Sheet1之类的
    Set ws = ActiveSheet
    
    ' 获取数据最后一行的行号
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 从最后一行往上循环，避免插入行影响循环计数
    For i = lastRow To 2 Step -1
        ' 拆分Items列的内容（这里Items在B列，根据实际调整）
        splitItems = Split(ws.Cells(i, "B").Value, ",")
        
        ' 如果拆分后有多个元素，就插入新行并填充内容
        If UBound(splitItems) > 0 Then
            ' 插入需要的行数（拆分后的数量-1）
            ws.Rows(i + 1 & ":" & i + UBound(splitItems)).Insert Shift:=xlDown
            
            ' 填充新行的Category列
            ws.Cells(i, "A").Copy Destination:=ws.Cells(i + 1, "A").Resize(UBound(splitItems))
            
            ' 填充每个拆分后的Item
            For j = 0 To UBound(splitItems)
                ws.Cells(i + j, "B").Value = Trim(splitItems(j)) ' Trim去掉可能的空格
            Next j
        End If
    Next i
End Sub

使用步骤： #

• 按Alt + F11打开VBA编辑器
• 右键点击当前工作簿，选择「插入」→「模块」
• 把上面的代码粘贴进去
• 按F5运行，或者回到Excel界面点击开发工具里的「宏」选择这个宏运行

方法2：数组批量处理（适合大数据量） #

如果你的数据行数很多，用数组操作会比直接操作单元格快得多，减少Excel的刷新开销：

Sub SplitItemsToRows_Array()
    Dim ws As Worksheet
    Dim inputArr As Variant, outputArr As Variant
    Dim lastRow As Long, i As Long, j As Long, outputRow As Long
    Dim splitItems As Variant
    
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 把数据读入数组
    inputArr = ws.Range("A1:B" & lastRow).Value
    
    ' 先估算输出数组的大小（最多是每行拆分成N个，这里先设为原行数的10倍，不够再调整）
    ReDim outputArr(1 To lastRow * 10, 1 To 2)
    outputRow = 1
    
    ' 写入表头
    outputArr(outputRow, 1) = inputArr(1, 1)
    outputArr(outputRow, 2) = inputArr(1, 2)
    outputRow = outputRow + 1
    
    ' 处理每一行数据
    For i = 2 To UBound(inputArr)
        splitItems = Split(inputArr(i, 2), ",")
        For j = 0 To UBound(splitItems)
            outputArr(outputRow, 1) = inputArr(i, 1)
            outputArr(outputRow, 2) = Trim(splitItems(j))
            outputRow = outputRow + 1
        Next j
    Next i
    
    ' 清空原数据区域（表头保留）
    ws.Range("A2:B" & lastRow).ClearContents
    
    ' 把输出数组写回工作表
    ws.Range("A2:B" & outputRow - 1).Value = outputArr
End Sub

注意事项： #

• 确保你的数据表头在第一行，Category在A列，Items在B列，如果位置不同，记得修改代码里的列索引
• 如果Items的分隔符不是逗号，把代码里的Split(..., ",")改成对应的分隔符，比如分号就改成";"
• 运行前建议先备份数据，避免意外情况

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