集合

Question

使用下面的代码，我可以获得任何父项的缩进BOM（在单元格D1中指定）。下面的屏幕截图显示了D，E和D列中的缩进bom。 F根据A列和B列中列出的父/子关系获得项目A.我想稍微扩展一下，以便每个子项的关联数量显示在G列中。我试图获取对应的地址vChild然后偏移1列，但我没有成功。

赞赏任何想法

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
        collRoot(rNode.Value).Add rNode.Offset(, 1).Value
    Next rNode

    sRootNode = Range("D1")
    Range("D2") = 0
    Range("F2") = sRootNode
    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
        rOut.Offset(lRow, 0) = lLevel
        Set coll = Nothing
        Set coll = collRoot(vChild)
        If Not coll Is Nothing Then Call DisplayTree1(vChild, rOut, lRow, lLevel + 1)
    Next vChild
End Sub

Answer 1

我选择使用vlookups来获取qty值