如何用VBA将树形BOM子件对应最近上层的父件找出来

chengshanming

请教各位高手，如何用VBA代码将子件对应最近的父件罗列出来。如图！

funsz

完全看不懂什么意思

chengshanming

funsz 发表于 2015-11-20 13:19
完全看不懂什么意思

层级为0的组件是最顶层成品料号，其下层组件有半成品料号也有原材料料号，黄色部分是我想要的结果，如果通过VBA代码来事项，因为有上万个成品BOM，太麻烦了！谢谢！

蓝桥玄霜

请见代码。

chengshanming

蓝桥玄霜 发表于 2015-11-20 15:17
请见代码。

首先谢谢蓝版了，能得到你的邮件回复是件很荣幸的事，难得的。老师，按您的代码提示以下错误，要怎么更改呢？多谢！
Public Arr, d, k, t
Sub lqxs()
Dim i&, myr&, n&
Set d = CreateObject("scripting.Dictionary")
Application.sgreenupdating = False
[c2:c50000].ClearContents
myr = Cells(Rows.Count, 2).End(xlUp).Row
Arr = Range("a1:b" & myr)
For i = 2 To UBound(Arr)
n = Len(Arr(i, 1))
d(n) = d(n) & i & ","
Next|
k = d.keys: t = d.items
For i = 1 To UBound(k)
Call yy(t(i), i)
Next
MsgBox "ok"
Application.ScreenUpdating = True
End Sub
Sub yu(tt, c)
Dim t1, t2, j&, aa, sj, i&, bb
t1 = Left(t(c - 1), Len(t(c - 1)) - 1) '上一级所在的行
t2 = Left(tt, Len(tt) - 1) '本级所在的行
If InStr(t2, ",") Then
bb = Split(t2, ",")
For j = 0 To UBound(bb)
If InStr(t1, ",") Then
aa = Split(t1, ",")
For i = UBound(aa) To 0 Step -1
If Val(bb(j)) > Val(aa(i)) Then
sj = aa(i) 'sj上一级
Cells(bb(j), 3) = Cells(sj, 2).Value
Exit For
End If
Next
Else
If Val(bb(j)) > Val(t1) Then
sj = t1 'sj-上级；
Cells(bb(j), 3) = Cells(sj, 2).Value
Exit For
End If
End If
Next
Else
sj = t2 - 1: Cells(t2, 3) = Cells(sj, 2).Value
End If
End Sub

chengshanming

Public Arr, d, k, t
Sub lqxs()
   Dim i&, myr&, n&
    Set d = CreateObject("scripting.Dictionary")
    Application.ScreenUpdating = False
    Range("c2:c500").ClearContents
    myr = Cells(Rows.Count, 2).End(xlUp).Row
    MsgBox myr

    Arr = Range("a1:b" & myr)
    For i = 2 To UBound(Arr)
        n = Len(Arr(i, 1))
        d(n) = d(n) & i & ","
    Next
    k = d.keys: t = d.items
    MsgBox d.Count
    For i = 1 To UBound(k)
        Call yy(t(i), i)
    Next
    MsgBox "ok"
    Application.ScreenUpdating = True
End Sub

Sub yy(tt, c)
    Dim t1, t2, j&, aa, sj, i&, bb
    t1 = VBA.Left(t(c - 1), Len(t(c - 1)) - 1)    '上一级所在的行
    t2 = VBA.Left(tt, Len(tt) - 1)     '本级所在的行
    If InStr(t2, ",") Then
        bb = Split(t2, ",")
        For j = 0 To UBound(bb)
            If InStr(t1, ",") Then
                aa = Split(t1, ",")
                For i = UBound(aa) To 0 Step -1
                    If Val(bb(j)) > Val(aa(i)) Then
                        sj = aa(i)    'sj上一级
                        Cells(bb(j), 3) = Cells(sj, 2).Value
                        Exit For
                    End If
                Next
            Else
                If Val(bb(j)) > Val(t1) Then
                    sj = t1    'sj-上级；
                    Cells(bb(j), 3) = Cells(sj, 2).Value
                    Exit For
                End If
            End If
        Next
    Else
        sj = t2 - 1: Cells(t2, 3) = Cells(sj, 2).Value
    End If
End Sub

已处理，多谢各位高手帮忙！代码如下

chengshanming

蓝桥玄霜 发表于 2015-11-20 15:17
请见代码。

蓝桥老师好！有以下需求问题请教您！

liujw_35

如果层级以数字1 2 3 4 5形式表示，该如何写？老师

kuangfengsj

liujw_35 发表于 2019-6-18 20:58
如果层级以数字1 2 3 4 5形式表示，该如何写？老师

按你的要求数字表示层级最后有解决吗，同求

singzhou

蓝桥玄霜 发表于 2015-11-20 15:17
请见代码。

大师，请帮忙处理一下，表格稍微修改了一下，导致0级下面的物料没有找到0级编码，谢谢！