如何将指定格式长字符串拆分为二维Variant数组并完成数据处理？

给定单元格内的长字符串格式如下：

1;#SCAN035545,2;#SCAN025196,3;#SCAN025192,4;#SCAN020504,5;#SCAN002824,6;#SCAN025354,7;#SCAN037102,8;#SCAN035977,9;#SCAN035763,10;#SCAN032932,11;#SCAN025000,12;#SCAN019935,13;#SCAN039383,14;#SCAN039376,15;#SCAN028043,16;#SCAN999999,17;#SCAN039427,18;#SCAN039419,19;#SCAN039188,20;#SCAN029674,21;#SCAN042707

需要完成以下操作：

• 找到SCAN999999对应的编号（16）并删除整项
• 对剩余项重新按顺序编号
• 将处理后的项合并为原格式的字符串
  同时需要支持动态数量的单元格和长度可变的字符串，当前卡在步骤1和2，纠结于拆分方式（比如转二维数组或ListObject），担心ListObject性能问题，寻求可行方案。

直接采用字符串拆分+内存数组/集合处理的方案，全程在内存中完成操作，性能远优于ListObject，且完美兼容动态场景。

核心思路 #

1. 按逗号,拆分原始字符串，得到单个编号;#SCANxxxxxx格式的项
2. 遍历每个项，按分号;拆分出编号与SCAN值，过滤掉SCAN值为#SCAN999999的项
3. 对过滤后的项重新按顺序生成编号
4. 将新编号与SCAN值合并回原格式字符串

完整VBA代码（集合版，简洁高效） #

Sub ProcessScanStrings()
    Dim targetRange As Range
    Dim cell As Range
    Dim originalStr As String
    Dim itemArr() As String
    Dim filteredItems As Collection
    Dim i As Integer, newNum As Integer
    Dim tempArr() As String
    Dim resultStr As String
    
    ' 选择要处理的单元格区域（可自行修改为固定范围，如Range("A1:A100")）
    Set targetRange = Application.Selection
    Set filteredItems = New Collection
    
    For Each cell In targetRange
        originalStr = cell.Value
        If originalStr <> "" Then
            ' 拆分所有项
            itemArr = Split(originalStr, ",")
            
            ' 过滤目标项
            filteredItems.Clear
            For i = LBound(itemArr) To UBound(itemArr)
                tempArr = Split(itemArr(i), ";")
                ' 容错：确保拆分后有编号和SCAN值两个元素
                If UBound(tempArr) = 1 Then
                    If tempArr(1) <> "#SCAN999999" Then
                        filteredItems.Add tempArr(1) ' 仅存储SCAN值，编号后续重新生成
                    End If
                End If
            Next i
            
            ' 重新编号并合并
            resultStr = ""
            newNum = 1
            For i = 1 To filteredItems.Count
                resultStr = resultStr & newNum & ";" & filteredItems(i)
                If i < filteredItems.Count Then resultStr = resultStr & ","
                newNum = newNum + 1
            Next i
            
            ' 将结果写回单元格
            cell.Value = resultStr
        End If
    Next cell
End Sub

代码说明 #

• 性能优先：全程内存操作，避免工作表交互，处理大量单元格时速度优势明显
• 动态兼容：无论字符串长度、单元格数量多少，只要符合编号;#SCANxxxxxx的项用逗号分隔，均可处理
• 容错机制：加入拆分后元素数量判断，避免格式异常导致报错
• 灵活修改：若需过滤其他SCAN值，仅需修改tempArr(1) <> "#SCAN999999"的判断条件

替代方案（Variant数组版，保留原项结构） #

如果需要保留原项的编号与SCAN值对应关系（方便后续扩展处理），可使用二维Variant数组存储：

Sub ProcessScanStringsWithVariant()
    Dim targetRange As Range
    Dim cell As Range
    Dim originalStr As String
    Dim itemArr() As String
    Dim filteredArr() As Variant
    Dim i As Integer, newIdx As Integer
    Dim tempArr() As String
    Dim resultStr As String
    
    Set targetRange = Application.Selection
    
    For Each cell In targetRange
        originalStr = cell.Value
        If originalStr <> "" Then
            itemArr = Split(originalStr, ",")
            ' 初始化过滤数组
            ReDim filteredArr(1 To UBound(itemArr) + 1, 1 To 2)
            newIdx = 0
            
            For i = LBound(itemArr) To UBound(itemArr)
                tempArr = Split(itemArr(i), ";")
                If UBound(tempArr) = 1 Then
                    If tempArr(1) <> "#SCAN999999" Then
                        newIdx = newIdx + 1
                        filteredArr(newIdx, 1) = tempArr(0) ' 原编号（后续会被覆盖）
                        filteredArr(newIdx, 2) = tempArr(1)
                    End If
                End If
            Next i
            
            ' 调整数组大小并重新编号合并
            If newIdx > 0 Then
                ReDim Preserve filteredArr(1 To newIdx, 1 To 2)
                resultStr = ""
                For i = 1 To newIdx
                    resultStr = resultStr & i & ";" & filteredArr(i, 2)
                    If i < newIdx Then resultStr = resultStr & ","
                Next i
                cell.Value = resultStr
            Else
                cell.Value = "" ' 若所有项被过滤，清空单元格
            End If
        End If
    Next cell
End Sub

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