Excel含可变分隔符文本分列问题求助

原宏的问题在于用TextToColumns按逗号做固定列数的拆分，但你的数据中逗号数量不固定（0个：仅编号；1个：姓名+编号；2个：姓+名+编号），导致编号无法统一落到同一列。下面是优化后的代码，直接针对编号始终在末尾的规则来处理，不管前面有几个逗号：

Sub SplitNameAndParticipantID()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim cell As Range
    Dim splitArr As Variant
    Dim namePart As String
    Dim i As Integer
    
    ' 设置当前工作表，可根据需要修改
    Set ws = ActiveSheet
    
    ' 插入两列用于存放姓名和编号（如果已有目标列可跳过这步）
    ws.Columns("B:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    ' 获取A列最后一行有效数据
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 设置表头
    ws.Range("B1").Value = "Participant Name" ' 姓氏+名字合并列，需拆分可调整
    ws.Range("C1").Value = "Participant Number"
    
    ' 遍历A列数据行（从第2行开始，假设第1行是原表头）
    For Each cell In ws.Range("A2:A" & lastRow)
        If cell.Value <> "" Then
            ' 按逗号拆分单元格内容为数组
            splitArr = Split(cell.Value, ",")
            
            ' 数组最后一个元素就是参与者编号，去除前后空格
            ws.Cells(cell.Row, "C").Value = Trim(splitArr(UBound(splitArr)))
            
            ' 处理姓名部分：拼接除编号外的所有元素
            If UBound(splitArr) > 0 Then
                namePart = ""
                For i = 0 To UBound(splitArr) - 1
                    namePart = namePart & Trim(splitArr(i)) & " "
                Next i
                ' 去掉末尾多余空格后写入姓名列
                ws.Cells(cell.Row, "B").Value = Trim(namePart)
            Else
                ' 只有编号的情况，姓名列留空
                ws.Cells(cell.Row, "B").Value = ""
            End If
        End If
    Next cell
End Sub

关键优化点说明： #

• 摒弃Select操作：直接定位单元格赋值，比录制宏的Select方式更高效、更不容易出错
• 动态适配逗号数量：用Split把内容转成数组，通过UBound(splitArr)直接取最后一个元素作为编号，彻底解决逗号数量不固定的问题
• 灵活处理姓名：如果是「姓,名,编号」格式，会自动拼接成完整姓名；如果是「姓名,编号」或仅编号，也能正确匹配
• 精准处理范围：只用lastRow获取实际有数据的行，避免遍历整列浪费资源

如果需要把姓氏和名字拆分成单独列（比如B列存姓、C列存名、D列存编号），可以替换这段逻辑：

' 拆分姓氏和名字的版本（需提前插入3列）
If UBound(splitArr) = 2 Then
    ws.Cells(cell.Row, "B").Value = Trim(splitArr(0)) ' 姓氏
    ws.Cells(cell.Row, "C").Value = Trim(splitArr(1)) ' 名字
ElseIf UBound(splitArr) = 1 Then
    ws.Cells(cell.Row, "B").Value = Trim(splitArr(0)) ' 完整姓名
    ws.Cells(cell.Row, "C").Value = "" ' 名字列留空
End If
ws.Cells(cell.Row, "D").Value = Trim(splitArr(UBound(splitArr))) ' 编号

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