Excel多树节点结构深度计算优化及高效存储方案问询

核心优化思路 #

针对2万行的BOM数据，核心是用缓存机制避免重复遍历同一组件的子树：

• 使用VBA的Dictionary对象存储已计算完成的组件层级，键为组件编号，值为该组件的最高层级
• 递归遍历组件时，先检查缓存：若已存在则直接返回缓存值，不存在则计算后存入缓存
• 同一组件在不同树结构中出现时，取所有计算结果中的最大值作为最终最高层级

完整VBA代码实现 #

Option Explicit

' 模块级缓存字典，存储已计算的组件最高层级
Private componentLevelCache As Dictionary

Sub CalculateBOMMaxLevels()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim parentCol As Integer, childCol As Integer
    Dim components As Collection
    Dim comp As Variant
    Dim currentLevel As Integer
    Dim maxLevels As Dictionary
    
    ' 初始化工作表和列号（根据实际数据调整）
    Set ws = ThisWorkbook.Sheets("Sheet1")
    parentCol = 1 ' A列是父组件
    childCol = 2 ' B列是子组件
    lastRow = ws.Cells(ws.Rows.Count, parentCol).End(xlUp).Row
    
    ' 初始化缓存和结果字典
    Set componentLevelCache = New Dictionary
    Set maxLevels = New Dictionary
    
    ' 收集所有唯一组件（父+子）
    Set components = New Collection
    On Error Resume Next
    For i = 2 To lastRow ' 跳过表头
        components.Add ws.Cells(i, parentCol).Value, Key:=CStr(ws.Cells(i, parentCol).Value)
        components.Add ws.Cells(i, childCol).Value, Key:=CStr(ws.Cells(i, childCol).Value)
    Next i
    On Error GoTo 0
    
    ' 计算每个组件的最高层级
    For Each comp In components
        currentLevel = GetComponentMaxLevel(CStr(comp), ws, parentCol, childCol)
        ' 确保取最高层级（同一组件可能在不同树中层级不同）
        If maxLevels.Exists(CStr(comp)) Then
            If currentLevel > maxLevels(CStr(comp)) Then
                maxLevels(CStr(comp)) = currentLevel
            End If
        Else
            maxLevels.Add CStr(comp), currentLevel
        End If
    Next comp
    
    ' 输出结果（这里直接打印到立即窗口，可改为写入工作表）
    Debug.Print "组件最高层级列表："
    For Each comp In maxLevels.Keys
        Debug.Print comp & ":" & maxLevels(comp)
    Next comp
    
    ' 释放对象
    Set componentLevelCache = Nothing
    Set maxLevels = Nothing
    Set components = Nothing
End Sub

' 递归计算单个组件的最高层级，带缓存
Private Function GetComponentMaxLevel(component As String, ws As Worksheet, parentCol As Integer, childCol As Integer) As Integer
    Dim childComponents As Collection
    Dim child As Variant
    Dim maxChildLevel As Integer
    Dim currentChildLevel As Integer
    
    ' 先检查缓存，存在则直接返回
    If componentLevelCache.Exists(component) Then
        GetComponentMaxLevel = componentLevelCache(component)
        Exit Function
    End If
    
    ' 收集当前组件的所有子组件
    Set childComponents = New Collection
    On Error Resume Next
    For i = 2 To ws.Cells(ws.Rows.Count, parentCol).End(xlUp).Row
        If ws.Cells(i, parentCol).Value = component Then
            childComponents.Add ws.Cells(i, childCol).Value, Key:=CStr(ws.Cells(i, childCol).Value)
        End If
    Next i
    On Error GoTo 0
    
    ' 没有子组件，层级为1（根节点层级）
    If childComponents.Count = 0 Then
        GetComponentMaxLevel = 1
        componentLevelCache.Add component, 1
        Exit Function
    End If
    
    ' 递归计算所有子组件的层级，取最大值加1
    maxChildLevel = 0
    For Each child In childComponents
        currentChildLevel = GetComponentMaxLevel(CStr(child), ws, parentCol, childCol)
        If currentChildLevel > maxChildLevel Then
            maxChildLevel = currentChildLevel
        End If
    Next child
    
    GetComponentMaxLevel = maxChildLevel + 1
    ' 将计算结果存入缓存
    componentLevelCache.Add component, GetComponentMaxLevel
End Function

使用说明 #

1. 调整代码中的ws、parentCol、childCol参数，匹配你的实际数据位置（比如父组件在C列就把parentCol设为3）
2. 运行CalculateBOMMaxLevels宏后，结果会打印到VBA编辑器的立即窗口，你可以修改代码将结果写入工作表指定区域（比如从D1开始写入）
3. 代码自动处理同一组件在不同树结构中的情况，取所有出现场景中的最高层级
4. 缓存机制避免了重复遍历子树，2万行数据的处理效率会大幅提升

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