Excel VBA缩进BOM扩展需求：添加子项数量至G列

我明白你现在的需求：已经实现了基于父/子关系生成缩进BOM的功能，现在要在G列显示每个子项对应的数量，之前尝试获取vChild的单元格地址偏移没成功，核心问题是原代码的集合里只存储了子项名称，没有关联对应的数量信息。下面是具体的解决方案：

问题根源 #

原代码中collRoot集合只存储了子项的名称字符串，没有保存该子项对应的数量数据，所以后续无法直接获取数量。我们需要修改集合的存储结构，把子项名称+对应数量一起存储。

修改步骤及完整代码 #

假设你的数量数据在C列（A列父项、B列子项、C列对应数量），如果实际位置不同，只需调整代码中的Offset列数即可：

1. 修改集合存储逻辑 #

在DisplayTree过程中，把原来只添加子项名称的代码，改为添加包含子项名称和数量的数组：

' 原代码
' collRoot(rNode.Value).Add rNode.Offset(, 1).Value
' 修改为：
collRoot(rNode.Value).Add Array(rNode.Offset(, 1).Value, rNode.Offset(, 2).Value)

2. 修改递归过程中的数据写入 #

在DisplayTree1递归过程中，遍历子项时从数组中取出名称和数量，分别写入F列和G列：

' 原代码
' rOut.Offset(lRow, 2) = vChild
' 修改为：
rOut.Offset(lRow, 2) = vChild(0) ' 写入子项名称到F列
rOut.Offset(lRow, 3) = vChild(1) ' 写入数量到G列

' 同时，查找下一级父项时要使用子项名称（数组的第一个元素）
Set coll = collRoot(vChild(0))

完整修改后的代码 #

Public collRoot As Collection
Sub DisplayTree()
    Dim coll As Collection
    Dim rParents As Range, rNode As Range
    Dim rOut As Range, sRootNode As String, lRow As Long
    Dim rLevels As Range, rLevel As Range
    Dim level As Integer, maxLevels As Integer, cur As Integer, i As Integer
    Dim h As String, counts() As Integer
    Set collRoot = Nothing
    Set collRoot = New Collection
    Set rParents = Range("A2", Range("A2").End(xlDown))
    ' Store the tree in a collection - 现在存储子项名称+数量的数组
    On Error Resume Next
    For Each rNode In rParents
        Set coll = Nothing
        Set coll = collRoot(rNode.Value)
        If coll Is Nothing Then
            collRoot.Add New Collection, rNode.Value
        End If
        ' 添加包含子项名称和数量的数组（假设数量在C列，Offset(,2)）
        collRoot(rNode.Value).Add Array(rNode.Offset(, 1).Value, rNode.Offset(, 2).Value)
    Next rNode
    sRootNode = Range("D1")
    Range("D2") = 0
    Range("F2") = sRootNode
    ' 初始化G列标题（可选）
    Range("G1") = "数量"
    Set rOut = Range("D2")
    Call DisplayTree1(sRootNode, rOut, lRow, 1)
    ' Calculate Levels
    Set rLevels = Range("D3:D" & Range("D3").End(xlDown).Row)
    maxLevels = WorksheetFunction.Max(rLevels)
    ReDim counts(1 To maxLevels)
    cur = 1
    For Each rLevel In rLevels
        level = rLevel.Value
        h = ""
        counts(level) = counts(level) + 1
        For i = 1 To level
            h = h & "." & counts(i)
        Next
        h = Mid(h, 2)
        For i = level + 1 To UBound(counts)
            counts(i) = 0
        Next
        rLevel.Offset(, 1).Value = h
        cur = level
    Next
End Sub
Sub DisplayTree1(ByVal sParent As String, rOut As Range, _
    ByRef lRow As Long, ByVal lLevel As Long)
    Dim vChild, coll As Collection
    On Error Resume Next
    For Each vChild In collRoot(sParent)
        lRow = lRow + 1
        rOut.Offset(lRow, 2) = vChild(0) ' 子项名称写入F列
        rOut.Offset(lRow, 3) = vChild(1) ' 数量写入G列
        rOut.Offset(lRow, 0) = lLevel
        Set coll = Nothing
        ' 用子项名称（数组第一个元素）查找下一级子项
        Set coll = collRoot(vChild(0))
        If Not coll Is Nothing Then
            Call DisplayTree1(vChild(0), rOut, lRow, lLevel + 1)
        End If
    Next vChild
End Sub

关键说明 #

• 如果你的数量数据不在C列，比如在其他列，只需修改rNode.Offset(, 2)中的数字：例如数量在D列就改成Offset(,3)。
• 代码中添加了Range("G1") = "数量"来初始化G列标题，你可以根据需要调整或删除。
• 原代码中的On Error Resume Next用于处理父项不存在于集合中的情况，使用时注意后续的错误排查。

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