遍历二维数组，根据对应关系展开的VBA代码

laojiang8

各位好，

      目前在项目中遇到一个问题，需要将一个二维数组根据每一行的对应关系一步一步展开，形成最终线性关系的问题。如下图所示


这种情况如何通过VBA代码的方式来实现？

先说一下我的思路
1、取源数组中A列所有值并进行排重
2、确认父节点,检查A列排重之后的值是否在B列中存在 ，如果不存在 ，则认为是父结点
3、根据父节点,循环遍历A\B两列，如果找到子节点，直接挂在数组后面，然后依次遍历，形成目标数组
4、将目标数组输出到EXCEL

现在第1、2步已经写完，但是第3步不知道循环如何写，请各位大神帮忙指点一下，或大家有没有更好 的思路，谢谢

附近第1、2步代码

zpy2

这种情况一般都是用递归算法

laojiang8

zpy2 发表于 2018-9-28 11:46
这种情况一般都是用递归算法

能说一下大体的思路吗，谢谢

zpy2

http://club.excelhome.net/forum.php?mod=viewthread&tid=1412601&extra=&mobile=2

laojiang8

zpy2 发表于 2018-9-28 13:53
http://club.excelhome.net/forum.php?mod=viewthread&tid=1412601&extra=&mobile=2

Dim arrBom 'bom表
Dim arrOUT '输出表
Dim arrDD  '订单表
Dim n As Integer
Dim d As Object
Sub F(p, Q)
    Dim i, s
    i = d(p)
    While (arrBom(i, 1) & arrBom(i, 3) = p)
        n = n + 1
        For j = 1 To 4
            arrOUT(n, j) = arrBom(i, j + 3)
        Next
        arrOUT(n, 5) = arrBom(i, 8) * Q
        s = arrBom(i, 4) & arrBom(i, 6)
        If d.exists(s) Then _
            Call F(s, arrOUT(n, 5))
        i = i - 1
    Wend
End Sub
Sub Demo()
    Dim i&, j&, c&, p, k
   
    Set d = CreateObject("scripting.dictionary")
    arrBom = Sheets("BOM").Range("a1").CurrentRegion
    For i = 2 To UBound(arrBom)
        d(arrBom(i, 1) & arrBom(i, 3)) = i
    Next
   
    ReDim arrOUT(1 To UBound(arrBom) * 2, 1 To 5): c = 0
    For Each k In Array("编号", "名称", "规格", "单位", "数量")
        c = c + 1
        arrOUT(1, c) = k
    Next
   
    n = 1
    arrDD = Sheets("目标").Range("b1").CurrentRegion
    For i = 3 To UBound(arrDD)
        n = n + 1
        arrOUT(n, 1) = arrDD(i, 1)
        arrOUT(n, 2) = arrDD(i, 2)
        arrOUT(n, 3) = arrDD(i, 3)
        arrOUT(n, 5) = arrDD(i, 4)
        p = arrDD(i, 1) & arrDD(i, 3)
        Call F(p, arrDD(i, 4))
    Next
    Sheets("目标").Range("L9").Resize(n, UBound(arrOUT, 2)) = arrOUT
End Sub

根据那个帖子里的内容，发现跟我的这个需求很接近，完成可以解决我的问题。
但是有个问题 这段代码写的太牛了，很多函数都看不明白，能帮忙写一下注释吗，谢谢

laojiang8

zpy2 发表于 2018-9-28 13:53
http://club.excelhome.net/forum.php?mod=viewthread&tid=1412601&extra=&mobile=2

你好，能帮忙写一下这段代码的注释吗；或者直接通过VBA把我的那个需求实现一下，我愿意出50元，可以加我的QQ: 286417445 详聊；这个问题困扰我们太长时间了，麻烦 了