VBA无法检测文本前导空格判定数据层级的问题求解

问题场景 #

需要清理单列存储的层级化数据，数据通过条目开头的空格缩进量标识层级归属：

原始数据示例 #

Project B
            Implementation
                    AB - Item 1
                    BK - Item 2
                    CC - Item 3
                    CM - Item 4
                    SR - Environmental/R

期望输出格式 #

清理后按层级拆分到多列，用|分隔的效果如下：

Project B  |  Implementation | AB - Item 1
Project B  |  Implementation | BK - Item 2
Project B  |  Implementation | CC - Item 3
Project B  |  Implementation | CM - Item 4
Project B  |  Implementation | SR - Environmental/R

现有故障表现 #

现有代码无法稳定识别文本开头的所有前导空格，必须先手动通过查找替换把对应层级的缩进空格替换为(P)/(I)/(S)这类特殊标识，再用标识做判断才能完成清理，否则会出现层级匹配失败、条目漏处理的问题。
现有实现代码如下：

For i = 1 To NumRow
        If InStr(b_Range.Value2(i, 1), "                ") <> 0 Then
            b(k, 1) = Replace(b_Range.Value2(i, 1), "                ", "")
        ElseIf InStr(b_Range.Value2(i, 1), "            ") <> 0 Then
            b(k, 2) = Replace(b_Range.Value2(i, 1), "            ", "")
        ElseIf InStr(b_Range.Value2(i, 1), "    ") <> 0 Then
            b(k, 3) = Replace(b_Range.Value2(i, 1), "    ", "")
            
            For j = 1 To NumCol - 1
                A(k, j) = CDbl(b_Range.Value2(i, 1 + j))
            Next j
            k = k + 1
            b(k, 1) = b(k - 1, 1)
            b(k, 2) = b(k - 1, 2)
        End If
Next i

根因排查思路 #

• 匹配逻辑错误：代码用InStr()查找固定长度连续空格，该函数只要文本任意位置（包括条目名称中间）存在对应长度的连续空格就会触发匹配，并非仅识别开头的前导空格，极易出现误判；如果前导空格数和硬编码的长度不严格一致（比如多敲/少敲1个空格、缩进用了制表符而非半角空格），会直接匹配失败。
• 硬编码容错性为0：代码写死了16个、12个、4个空格三个判断阈值，只要原始数据排版时的缩进量不是严格对应这三个值，对应条目就会被直接跳过。
• 替换逻辑存在内容损坏风险：Replace()方法会全局替换文本中所有匹配的连续空格，而非仅删除开头的前导空格，如果条目名称本身包含连续空格，会直接损坏原始内容。
• 层级继承逻辑漏洞：代码仅在处理最内层条目时才复制上一行的父级值，一旦层级顺序出现波动、或者存在超过3层的结构，就会出现父级值丢失、层级串位的问题。

修复方案 #

放弃硬编码固定长度空格的匹配思路，直接计算每个条目前导空格的实际长度判定层级，通过缓存各层级当前值实现自动继承，不需要提前做特殊标识替换。
可直接运行的修复后代码如下：

Sub CleanIndentedHierarchy()
    Dim srcRng As Range
    Set srcRng = Selection
    Dim srcArr As Variant
    srcArr = srcRng.Value2
    Dim totalRow As Long, totalCol As Long
    totalRow = UBound(srcArr, 1)
    totalCol = UBound(srcArr, 2)
    
    ' 初始化输出数组，最大行数与源数据一致，固定3列对应三级层级
    Dim resArr() As String
    ReDim resArr(1 To totalRow, 1 To 3)
    Dim resRow As Long: resRow = 1
    
    ' 缓存各层级的当前有效值
    Dim levelCache(1 To 3) As String
    Dim i As Long
    Dim rawText As String, cleanText As String
    Dim leadLen As Long
    
    For i = 1 To totalRow
        rawText = CStr(srcArr(i, 1))
        ' 跳过空行
        If Trim(rawText) = "" Then GoTo LoopNext
        
        ' 计算真实前导缩进长度：原文本长度减去去除前导空格后的文本长度
        cleanText = LTrim(rawText)
        leadLen = Len(rawText) - Len(cleanText)
        
        ' 按缩进长度判定所属层级，阈值可根据实际排版规则调整
        Select Case leadLen
            Case Is < 8
                ' 一级节点：示例中为4空格缩进
                levelCache(1) = cleanText
                levelCache(2) = ""
                levelCache(3) = ""
            Case 8 To 16
                ' 二级节点：示例中为12空格缩进
                levelCache(2) = cleanText
                levelCache(3) = ""
            Case Is > 16
                ' 三级节点：示例中为20空格缩进，为最明细层
                levelCache(3) = cleanText
                ' 写入结果
                resArr(resRow, 1) = levelCache(1)
                resArr(resRow, 2) = levelCache(2)
                resArr(resRow, 3) = levelCache(3)
                resRow = resRow + 1
        End Select
LoopNext:
    Next i
    
    ' 结果输出到选中区域右侧，可根据需要修改输出位置
    srcRng.Offset(0, totalCol + 1).Resize(resRow - 1, 3).Value2 = resArr
End Sub

修复点说明 #

• 缩进量通过长度差计算，仅识别开头的前导空格，不受条目内容中间的空格干扰，允许缩进量存在小幅偏差，不会因为多1-2个空格就匹配失败
• 层级值做独立缓存，切换上级节点时自动清空下级缓存，不会出现父级值串位、丢失的问题
• 仅去除开头的前导空格，不会修改条目名称本身的内容
• 无需提前做空格替换为特殊标识的预处理，选中目标区域直接运行即可

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