Excel VBA代码优化需求：按长度拆分C列文本并补全对应列数据

需求说明 #

• 对C列文本按指定长度截断并插入新行，保留C列原有空白单元格
• C列拆分生成的新行，其A、B列需设为空白
• 若A、B列有数据但C列空白，需完整保留A、B列数据（原代码未实现该功能）

原有代码 #

Sub test()
Dim txt As String, temp As String, colA As String, colB As String
Dim a, b() As String, n, i As Long
Const myLen As Long = 70
a = Range("a1").CurrentRegion.Value
ReDim b(1 To Rows.Count, 1 To 3)
For i = 1 To UBound(a, 1)
    If a(i, 1) <> "" Then
        colA = a(i, 1)
        colB = a(i, 2)
        txt = Trim(a(i, 3))
        Do While Len(txt)
            If Len(txt) <= myLen Then
                temp = txt
            Else
                temp = Left$(txt, InStrRev(txt, " ", myLen))
            End If
            If temp = "" Then Exit Do
            n = n + 1
            b(n, 1) = colA: b(n, 2) = colB
            b(n, 3) = Trim(temp)
            txt = Trim(Mid$(txt, Len(temp) + 1))
        Loop
    End If
Next
Range("e1").Resize(n, 3).Value = b
End Sub

问题分析 #

原代码存在三个核心问题：

1. 仅处理A列非空的行，导致A/B列有数据但C列空白的行被直接跳过，无法保留
2. 拆分C列文本生成的所有新行，都继承了原行的A/B数据，不符合"新行A/B设为空白"的要求
3. 未处理C列空白且A/B也空白的行，无法保留原有空白行

修改后的代码 #

Sub SplitTextAndPreserveRows()
    Dim txt As String, temp As String
    Dim colA As String, colB As String
    Dim a, b() As Variant
    Dim n As Long, i As Long, splitCount As Long
    Const myLen As Long = 70
    
    ' 读取原始数据
    a = Range("a1").CurrentRegion.Value
    ' 初始化结果数组，预留足够空间
    ReDim b(1 To UBound(a, 1) * 10, 1 To 3)
    
    For i = 1 To UBound(a, 1)
        colA = a(i, 1)
        colB = a(i, 2)
        txt = Trim(a(i, 3))
        
        ' 情况1：C列有文本需要拆分
        If Len(txt) > 0 Then
            splitCount = 0
            Do While Len(txt) > 0
                ' 按空格截断，避免拆分单词
                If Len(txt) <= myLen Then
                    temp = txt
                Else
                    temp = Left$(txt, InStrRev(txt, " ", myLen))
                    ' 极端情况：文本中无空格，强制截断
                    If temp = "" Then temp = Left$(txt, myLen)
                End If
                
                n = n + 1
                ' 第一行保留原A/B数据，后续拆分行A/B设为空
                If splitCount = 0 Then
                    b(n, 1) = colA
                    b(n, 2) = colB
                Else
                    b(n, 1) = ""
                    b(n, 2) = ""
                End If
                b(n, 3) = Trim(temp)
                
                ' 剩余文本继续处理
                txt = Trim(Mid$(txt, Len(temp) + 1))
                splitCount = splitCount + 1
            Loop
        Else
            ' 情况2：C列空白，直接保留当前行的A/B/C数据
            n = n + 1
            b(n, 1) = colA
            b(n, 2) = colB
            b(n, 3) = a(i, 3) ' 保留原始空白，不Trim
        End If
    Next i
    
    ' 将结果写入E1开始的区域
    If n > 0 Then
        Range("e1").Resize(n, 3).Value = b
    End If
End Sub

关键修改点说明 #

1. 取消A列非空判断：遍历所有行，确保A/B有数据但C空的行、全空白行都能被处理
2. 拆分行A/B控制：通过splitCount变量标记拆分的行序号，第一行保留原A/B数据，后续拆分行A/B设为空
3. 空白行完整保留：单独处理C列空白的情况，直接写入原始A/B/C数据，保留原有空白单元格
4. 极端情况兼容：增加了文本无空格时的强制截断逻辑，避免死循环

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