我来帮你搞定这个问题！你的需求是把H、I、J三列的所有数据（不管单元格里有没有; 分隔符）都整理到R列，同时对带分隔符的单元格拆分内容并生成对应新行对吧？原代码的问题在于只处理了包含; 的单元格，没有分隔符的单元格直接被跳过了，所以这些内容根本没写到R列里。

咱们换个更可靠的思路来实现：从最后一行往上遍历（避免插入新行打乱遍历顺序），对每个单元格的内容进行拆分（哪怕没有分隔符，Split函数也会返回只有一个元素的数组），然后根据拆分后的元素数量处理行插入，最后把所有内容同步到R列。

修改后的完整VBA代码 #

Sub SplitAndCopyToR()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, col As Integer, j As Integer
    Dim cellValue As String
    Dim splitArr As Variant
    
    ' 设置当前工作表
    Set ws = ActiveSheet
    ' 关闭屏幕更新，提升运行速度
    Application.ScreenUpdating = False
    
    ' 获取最后一行（以H列为准，可根据实际调整）
    lastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
    
    ' 从最后一行往上遍历，避免插入行影响行号
    For i = lastRow To 1 Step -1
        ' 遍历H、I、J三列（对应列号8、9、10）
        For col = 8 To 10
            cellValue = ws.Cells(i, col).Value
            If cellValue <> "" Then ' 跳过空单元格
                ' 拆分内容，不管有没有分隔符
                splitArr = Split(cellValue, "; ")
                
                ' 如果拆分后有多个元素，插入对应数量的新行
                If UBound(splitArr) > 0 Then
                    ws.Rows(i + 1 & ":" & i + UBound(splitArr)).Insert
                    ' 复制原行内容到新插入的行，保证其他列数据不丢失
                    ws.Rows(i).Copy ws.Rows(i + 1 & ":" & i + UBound(splitArr))
                End If
                
                ' 将拆分后的内容写入原列和R列（第18列）
                For j = 0 To UBound(splitArr)
                    ws.Cells(i + j, col).Value = splitArr(j)
                    ws.Cells(i + j, 18).Value = splitArr(j) ' 18对应R列
                Next j
            End If
        Next col
    Next i
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    MsgBox "处理完成！"
End Sub

代码逻辑说明 #

• 反向遍历：从最后一行往第一行处理，插入新行不会改变未处理行的行号，避免遗漏或重复处理。
• 全场景覆盖：不管单元格有没有; 分隔符，都会用Split拆分——没有分隔符时，数组只有一个元素，直接写入原列和R列，解决了原代码遗漏无分隔符单元格的问题。
• 行插入与复制：如果拆分后有多个元素，自动插入对应数量的新行，并复制原行所有内容，保证其他列的数据不会丢失。
• 效率优化：关闭屏幕更新，减少运行时的界面闪烁，提升处理速度。

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