Excel中BOM动态层级结构转换求助：递归函数实现遇阻

核心思路 #

通过递归函数遍历每个父项的所有子项，按层级深度依次填充到目标列中，适配动态变化的层级数量。

VBA实现代码 #

打开Excel，按Alt+F11打开VBA编辑器，插入新模块，粘贴以下代码：

Option Explicit

' 主函数：启动BOM转换
Sub ConvertBOMToHierarchy()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim parentDict As Object
    Dim i As Long
    
    ' 设置源表和目标表（可根据实际修改）
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
    Set targetSheet = ThisWorkbook.Worksheets("Sheet2")
    Set parentDict = CreateObject("Scripting.Dictionary")
    
    ' 读取所有父-子关系到字典
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow ' 假设第一行是表头
        Dim parentCode As String
        Dim childCode As String
        parentCode = sourceSheet.Cells(i, "A").Value
        childCode = sourceSheet.Cells(i, "B").Value
        
        If Not parentDict.Exists(parentCode) Then
            parentDict(parentCode) = New Collection
        End If
        parentDict(parentCode).Add childCode
    Next i
    
    ' 清空目标表并写入表头
    targetSheet.Cells.Clear
    targetSheet.Cells(1, 1).Value = "层级1"
    targetSheet.Cells(1, 2).Value = "层级2"
    targetSheet.Cells(1, 3).Value = "层级3"
    ' 可按需添加更多表头，代码会自动适配超过的层级
    
    ' 遍历所有顶级父项（即不在子项中的编码）
    Dim topParents As Collection
    Set topParents = GetTopParents(sourceSheet, parentDict)
    Dim topParent As Variant
    Dim targetRow As Long
    targetRow = 2
    
    For Each topParent In topParents
        ' 递归展开顶级父项
        RecurseBOM topParent, 1, targetRow, parentDict, targetSheet
    Next topParent
    
    MsgBox "BOM转换完成！"
End Sub

' 获取所有顶级父项（没有父项的编码）
Function GetTopParents(sourceSheet As Worksheet, parentDict As Object) As Collection
    Dim allChildren As Object
    Dim lastRow As Long
    Dim i As Long
    Dim childCode As String
    Dim parentCode As Variant
    
    Set allChildren = CreateObject("Scripting.Dictionary")
    Set GetTopParents = New Collection
    
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "B").End(xlUp).Row
    ' 收集所有子项编码
    For i = 2 To lastRow
        childCode = sourceSheet.Cells(i, "B").Value
        If Not allChildren.Exists(childCode) Then
            allChildren(childCode) = True
        End If
    Next i
    
    ' 找出不在子项中的父项，即为顶级父项
    For Each parentCode In parentDict.Keys
        If Not allChildren.Exists(parentCode) Then
            GetTopParents.Add parentCode
        End If
    Next parentCode
End Function

' 递归展开BOM层级
Sub RecurseBOM(currentCode As String, currentLevel As Integer, ByRef targetRow As Long, parentDict As Object, targetSheet As Worksheet)
    ' 写入当前层级的编码
    targetSheet.Cells(targetRow, currentLevel).Value = currentCode
    
    ' 如果当前编码有子项，继续递归
    If parentDict.Exists(currentCode) Then
        Dim childCode As Variant
        Dim newRow As Long
        
        For Each childCode In parentDict(currentCode)
            ' 复制当前行的上层编码到新行
            newRow = targetRow + 1
            targetSheet.Rows(targetRow).Copy targetSheet.Rows(newRow)
            ' 写入子项到下一层级
            targetSheet.Cells(newRow, currentLevel + 1).Value = childCode
            ' 递归处理子项
            RecurseBOM childCode, currentLevel + 1, newRow, parentDict, targetSheet
            targetRow = newRow
        Next childCode
    End If
End Sub

使用说明 #

1. 将你的BOM数据放在Sheet1的A、B列，第一行设为表头（比如A1="父项编码"，B1="子项编码"）
2. 确保Excel启用了“Microsoft Scripting Runtime”（VBA编辑器中，工具→引用→勾选该选项）
3. 运行ConvertBOMToHierarchy宏，结果会输出到Sheet2中

注意事项 #

• 代码会自动识别所有顶级父项并展开，不管层级有多深
• 如果层级超过预设的表头数量，代码会自动继续往后列填充，无需额外修改表头

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