特定列含|字符时复制行、拆分值生成多行的VBA实现求助

需求说明 #

• 目标列：I列
• 触发规则：仅当单元格内容包含竖线|时执行操作
• 核心操作：
  1. 复制当前行
  2. 统计单元格内|的数量，插入对应数量的新行（比如有2个|就插2行，拆分后得到3个值）
  3. 将原单元格内容按|拆分，把每个值分别放到原行和新增行的I列中，其他列内容与原行保持一致

现有代码的问题 #

你提供的代码仅完成了检测含|的单元格、统计分隔符数量这两步，核心的插入行、内容拆分和行内容复制/赋值逻辑完全缺失，而且rownum = ActiveCell.row的写法错误——应该取当前遍历的单元格c所在行号，而非活动单元格的行号。

修正后的完整VBA代码 #

Private Sub SplitRowsByPipe()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim splitValues As Variant
    Dim pipeCount As Integer
    
    ' 指定操作的工作表，可根据实际修改为Sheet1之类的名称
    Set ws = ThisWorkbook.ActiveSheet
    ' 获取I列最后一个有内容的行号
    lastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row
    
    ' 从最后一行往上遍历，避免插入行导致的索引错乱
    For i = lastRow To 1 Step -1
        ' 检查当前I列单元格是否包含竖线
        If InStr(ws.Cells(i, "I").Value, "|") > 0 Then
            ' 按竖线拆分单元格内容为数组
            splitValues = Split(ws.Cells(i, "I").Value, "|")
            pipeCount = UBound(splitValues) ' 拆分后的元素个数-1就是竖线的数量
            
            ' 插入对应数量的空行（需要插入pipeCount行，原行保留第一个值）
            ws.Rows(i + 1 & ":" & i + pipeCount).Insert Shift:=xlDown
            
            ' 将拆分后的值写入对应行的I列，同时复制原行其他内容
            For j = 0 To pipeCount
                If j > 0 Then
                    ' 复制原行到新增行
                    ws.Rows(i).Copy Destination:=ws.Rows(i + j)
                End If
                ' 写入拆分后的单个值
                ws.Cells(i + j, "I").Value = splitValues(j)
            Next j
        End If
    Next i
End Sub

关键逻辑解释 #

• 从下往上遍历：插入行会改变后续行的行号，从最后一行往前遍历能避免漏处理或重复处理行
• Split函数：直接按|拆分内容为数组，比通过长度差统计分隔符数量更高效准确
• 插入行控制：根据拆分后的元素个数确定插入行数，确保每个拆分后的值都有对应的行
• 行内容复制：先复制原行的格式和其他列内容到新增行，再替换I列的拆分后值，保证其他列内容与原行一致

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