基于父子层级的分组项分类：Excel VBA提取父级信息及权重计算求助

实现逻辑 #

• 遍历数据行时，维护长度为11的数组存储1-10级最新的对应项信息，遇到层级为N的行时，其父项直接取数组中N-1级的存储值，完美适配层级升降的场景
• 权重汇总采用子项数值向上累加到所有上级父项的逻辑，所有子、孙级数值会自动累计到3级及以上的各级父项中
• 所有数据先读入内存数组处理，完成后统一写入单元格，数千行数据也能秒级处理完成

示例代码 #

Sub 层级信息处理()
    Dim lastRow As Long, i As Long, currLevel As Integer, l As Integer
    Dim levelArr(1 To 10) As Variant '存储各层级最新的项信息
    Dim dataArr As Variant, weightArr As Variant
    
    '获取当前工作表最后一行行号
    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    '读取B列（层级）、D列（当前项名称）、E列（当前项数值）到数组
    dataArr = Range("B1:E" & lastRow).Value
    '初始化权重存储数组
    ReDim weightArr(1 To lastRow, 1 To 2) '第1列存父项名称，第2列存汇总权重
    
    '清空上一次结果
    Range("C1:C" & lastRow).ClearContents
    Range("F1:F" & lastRow).ClearContents
    
    '遍历每行处理父项
    For i = 2 To lastRow '假设第1行是表头，从第2行开始处理
        currLevel = dataArr(i, 1) 'B列是层级
        If currLevel >= 3 Then
            '当前层级≥3时，父项为上一级（currLevel-1）存储的项名称
            weightArr(i, 1) = levelArr(currLevel - 1)
            '当前项数值累加到所有上级父项的权重中
            For l = 3 To currLevel
                weightArr(levelArr(l & "_row"), 2) = weightArr(levelArr(l & "_row"), 2) + dataArr(i, 4)
            Next l
        End If
        '更新当前层级的最新项信息和行号
        levelArr(currLevel) = dataArr(i, 3) 'D列是当前项名称
        levelArr(currLevel & "_row") = i '存储当前层级项所在行号，用于权重汇总
    Next i
    
    '将处理结果写入表格：C列存父项，F列存汇总权重
    Range("C1:C" & lastRow) = Application.Index(weightArr, 0, 1)
    Range("F1:F" & lastRow) = Application.Index(weightArr, 0, 2)
End Sub

适配调整说明 #

• 若你的表格层级、项名称、数值所在列和示例不一致，修改dataArr = Range("B1:E" & lastRow)中的列范围，以及取值的索引即可
• 若不需要保留3级以下层级的处理逻辑，直接调整判断条件即可

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