在列表结构中向下钻取

Question

我有两张Excel文件：

Sheet1包含材料清单：

Module 1
Module 3
Module 7

Sheet2包含一份物料清单：

Module 1    Part 1
Module 1    Part 2
Module 1    Part9
Part 9  Part11
Part 9  Part13
Part 9  Part14
Module 2    Part 20
Module 2    Part 21
Module 3    Part 45
Module 3    Part 46
Module 3    Part 48
Module 3    Part 49
Module 4    Part 71
Module 4    Part 82
Module 7    Part 77
Module 7    Part 78
Part 78 Part 100
Part 78 Part 101
Part 78 Part 103
Part 103    Part177
Part 103    Part178

我想深入查看sheet1中的列表，并从表2中获取结构所包含的所有材料的列表：

Module 1
Part 1
Part 2
Part 9
Part 11
Part 14
Module 3
Part 45
Part 46
Part 48
Part 49
Module 7
Part 77
Part 78
Part 100
Part 101
Part 103
Part 177
Part 178

我知道这是一些递归vba宏我需要＆＃34;向下钻取＆＃34;在结构中。我怎么能用vba宏做到这一点？

    Sub GetQuantities()

Const ModelCol = "A"
Const ModelQntyCol = "B"
Const ParentCol = "C"
Const Childcol = "D"
Const ChildQuantCol = "E"
Const ModelOutCol = "F"
Const PartCol = "G"
Const PartQntCol = "H"


Const StartDataRow = 3
SummaryRowCount = StartDataRow

Lastrow = Range(ParentCol & Rows.Count).End(xlUp).Row

Set ParentRange = Columns(ParentCol)
Set ChildRange = Columns(Childcol)
Set TopLevelPart = Columns(ModelCol)

For RowCount = StartDataRow To Lastrow
  Child = Range(Childcol & RowCount)
  'Check if child is lowest level part by search through parent column
  Set c = ParentRange.Find(what:=Child, LookIn:=xlValues, lookat:=xlWhole)
  If c Is Nothing Then
   ChildQuant = Range(ChildQuantCol & RowCount)
   'part is lowest level part
   'now search for all parents
   PartParent = Range(ParentCol & RowCount)

   'loop until part is found as another parent
   Do
     Set c = ChildRange.Find(what:=PartParent, LookIn:=xlValues, lookat:=xlWhole)
     If Not c Is Nothing Then
      Quant = Range(ChildQuantCol & c.Row)
      ChildQuant = ChildQuant * Quant
      PartParent = Range(ParentCol & c.Row)
     End If
   Loop While Not c Is Nothing

   'Parent should now contain a top level part
   'search for top level part
   Set c = TopLevelPart.Find(what:=PartParent, LookIn:=xlValues, lookat:=xlWhole)
   If c Is Nothing Then
     MsgBox ("Cannot find top Level Part : " & PartParent)
   Else
     Quant = Range(ModelQntyCol & c.Row)
     ChildQuant = ChildQuant * Quant
     Range(ModelOutCol & SummaryRowCount) = PartParent
     Range(PartCol & SummaryRowCount) = Child
     Range(PartQntCol & SummaryRowCount) = ChildQuant
     SummaryRowCount = SummaryRowCount + 1
   End If
  End If

Next RowCount


End Sub

它列出了所有顶级材料包含的所有childes。如下所示：

Module 1    Part 1  1
Module 1    Part 2  1
Module 1    Part11  1
Module 1    Par13   1
Module 1    Part14  1
Module 3    Part45  1
Module 3    Part46  1
Module 3    Part48  1
Module 3    Part49  1
Module 7    Part77  1
Module 7    Part100 1
Module 7    Part101 1
Module 7    Part177 1
Module 7    Part178 1

但我想在列表中包含所有级别，例如：

Part78   Part100
Part78   Part101
Part78   Part103