如何用Excel VBA将分号分隔的单元格字符串拆分为两个列表？

这需求我太熟了！给你整两个实用的实现方案，比你设想的循环拆分更顺手，还兼顾了鲁棒性～

方式一：用Collection动态存储结果（适合不确定元素数量的场景） #

Collection是VBA里动态存储数据的好帮手，不用提前指定长度，直接往里加元素就行：

Sub SplitToTwoLists(inputStr As String, ByRef leftList As Collection, ByRef rightList As Collection)
    ' 初始化两个空集合
    Set leftList = New Collection
    Set rightList = New Collection
    
    ' 第一步：先把整个字符串按分号拆成单个元素
    Dim elements() As String
    elements = Split(inputStr, ";")
    
    ' 第二步：遍历每个元素，按点拆分左右部分
    Dim elem As Variant
    Dim parts() As String
    For Each elem In elements
        ' 跳过空元素（避免字符串末尾多了分号导致的无效项）
        If Trim(elem) <> "" Then
            parts = Split(elem, ".")
            ' 确保每个元素都有且仅有一个点，防止格式错误报错
            If UBound(parts) = 1 Then
                leftList.Add parts(0) ' 存入点左侧的内容
                rightList.Add parts(1) ' 存入点右侧的内容
            End If
        End If
    Next elem
End Sub

调用示例： #

Sub TestSplitCollection()
    Dim inputStr As String
    inputStr = "AXX1.CYY1;AXX2.CYY2;AXX3.CYY3;AXX4.CYY4"
    
    Dim leftCol As Collection, rightCol As Collection
    Call SplitToTwoLists(inputStr, leftCol, rightCol)
    
    ' 打印左侧列表内容
    Debug.Print "点左侧的列表："
    Dim i As Integer
    For i = 1 To leftCol.Count
        Debug.Print leftCol(i)
    Next i
    
    ' 打印右侧列表内容
    Debug.Print vbNewLine & "点右侧的列表："
    For i = 1 To rightCol.Count
        Debug.Print rightCol(i)
    Next i
End Sub

方式二：用数组存储结果（适合追求读取效率的场景） #

如果习惯用数组操作，或者提前知道元素数量，这个方案更高效：

Function SplitToTwoArrays(inputStr As String) As Variant
    Dim elements() As String
    elements = Split(inputStr, ";")
    
    ' 先统计有效元素的数量（跳过空值）
    Dim validCount As Integer
    validCount = 0
    Dim elem As Variant
    For Each elem In elements
        If Trim(elem) <> "" Then validCount = validCount + 1
    Next elem
    
    ' 初始化对应长度的数组
    Dim leftArr() As String, rightArr() As String
    ReDim leftArr(1 To validCount)
    ReDim rightArr(1 To validCount)
    
    ' 填充数组内容
    Dim idx As Integer
    idx = 1
    Dim parts() As String
    For Each elem In elements
        If Trim(elem) <> "" Then
            parts = Split(elem, ".")
            If UBound(parts) = 1 Then
                leftArr(idx) = parts(0)
                rightArr(idx) = parts(1)
                idx = idx + 1
            End If
        End If
    Next elem
    
    ' 返回包含两个数组的变体对象
    SplitToTwoArrays = Array(leftArr, rightArr)
End Function

调用示例： #

Sub TestSplitArrays()
    Dim inputStr As String
    inputStr = "AXX1.CYY1;AXX2.CYY2;AXX3.CYY3;AXX4.CYY4"
    
    Dim result As Variant
    result = SplitToTwoArrays(inputStr)
    
    Dim leftArr() As String, rightArr() As String
    leftArr = result(0)
    rightArr = result(1)
    
    Debug.Print "点左侧的数组："
    Dim i As Integer
    For i = LBound(leftArr) To UBound(leftArr)
        Debug.Print leftArr(i)
    Next i
    
    Debug.Print vbNewLine & "点右侧的数组："
    For i = LBound(rightArr) To UBound(rightArr)
        Debug.Print rightArr(i)
    Next i
End Sub

小提醒： #

• 代码里加了空值过滤和拆分格式检查，就算输入字符串末尾多了分号，或者某个元素格式不对，也不会直接报错，实用性更强。
• 如果你的输入格式绝对规范（每个元素都有一个点，没有多余分号），可以去掉这些判断让代码更简洁，但还是建议保留，避免意外情况。

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