VBA：是否使用类模块/集合和/或动态数组？

我的问题是：

我需要能够通读多个产品结构。我不知道提前多少层次的产品结构深入。例如，我可以有以下内容：

产品A使用以下组件

• A1
• A2
• A3
• A4

但组件A3可能是一个子组件，它有自己的产品结构，需要拉动。因此，我将最终得出产品A的完整产品结构，如下所示：

A使用：

• A1
• A2
• A3（使用以下组件）：
  • A3A
  • A3B（使用以下部件）： *A3B1 *A3B2 *A3B3
  • A3C
  • A3D
• A4

等等

我当前的代码使用数组来包含通过DB查询检索到的信息，如下所示

Dim NumRecords As Integer
Dim X As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim sSQL As String
Dim PPS() As String 'Product structure returned from database query for the parent item
Dim ParentName as String ' Parent Product
Dim Plt as String ' Plant of Manufacture
Dim DBPath as string 'File path for the database


Set db = OpenDatabase(DBPath)
sSQL = "SELECT Component, NumberUsed FROM ProdStructMstr WHERE (((Parent)='" & ParentName & "') AND ((Plant)='" & Plt & "')) ORDER BY Component;"
Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
rs.MoveLast
rs.MoveFirst
If Not rs.EOF Then NumRecords = rs.RecordCount
If NumRecords > 0 Then
    ReDim PPS(NumRecords - 1, 1)
    rs.MoveFirst
    For X = 0 To NumRecords - 1
        PPS(X, 0) = rs!Component
        PPS(X, 1) = rs!NumberUsed
        rs.MoveNext
    Next X
Else
    MsgBox "ERROR: DB Table Empty or Not Found!", vbExclamation, "DATA ERROR"
End If
Set rs = Nothing
Set db = Nothing

我的问题是，它不能深入到产品结构的1层以上，这意味着它不能提取子组件的信息。我想我想用一个类模块和一个集合来解决这个问题，但我不能完全理解它

子组件A3的产品结构信息列在ProdStructMstr表中，A3列为父组件，组件列在表中

DB表如何查找此项的示例如下：

Plant | Parent | Component | NumberUsed Z | A | A1 | 1 Z | A | A2 | 3 Z | A | A3 | 1 Z | A | A4 | 2 Z | A3 | A3A | 1 Z | A3 | A3B | 1 Z | A3 | A3C | 2 Z | A3 | A3D | 1 Z | A3B | A3B1 | 1 Z | A3B | A3B2 | 4 Z | A3B | A3B3 | 1 植物|母体|成分|编号 Z | A | A1 | 1 Z | A | A2 | 3 Z | A | A3 | 1 Z | A | A4 | 2 Z | A3 | A3A | 1 Z | A3 | A3B | 1 Z | A3 | A3C | 2 Z | A3 | A3D | 1 Z | A3B | A3B1 | 1 Z | A3B | A3B2 | 4 Z | A3B | A3B3 | 1

---

这是一个很长的答案，但也许会有帮助

我提供了两个版本来说明嵌套字典在您的案例中的使用

测试数据（主要部分为浅橙色）：

---

第1版

输出：

---

版本1有两个主要过程

• 从Sheet1读取所有行的程序：

  ReadData（）

• 第二个按行生成嵌套字典：

  SetItms（）

  • 列B（父）-级别1-这些项是顶级字典中的键
  • 第C列（组件）-第2级-顶级字典的值和子字典的键
  • 列D（NumberUsed）-第3级-每个子字典中的值

---

这使用字典，并且后期绑定速度很慢：CreateObject（“Scripting.Dictionary”）

早期绑定很快：VBA编辑器->工具->参考->添加Microsoft脚本运行时

---

---

---

第2版

输出：

---

版本2只创建字典的两级嵌套（级别1=行，级别2=列）

---

---

注:

• 您可以将所有过程（两个版本）放在同一个模块中
• 这假设Sheet1上的UsedRange从单元格A1开始，并且是连续的

---

我怀疑问题在于，您需要像查询关系数据库一样查询大型机数据库。但根据您提供的示例表，情况并非如此。那张表没有标准化

我猜在sql查询中

“从ProdStructMstr中选择组件，编号，其中（（（父项）='”&ParentName&“）和（（工厂）='&Plt&“）按组件排序；”

Parent

可能等于“A”，因此您要返回的记录集仅由组件A1、A2、A3和A4组成

如果是这种情况，那么您需要更改SQL查询以使用如下所示的

Like

关键字（您可能需要调整语法）

“从ProdStructMstr中选择组件，编号，其中（（父级）=如“&ParentName&“*”）和（（工厂）=“&Plt&“”）按组件排序；”

---

这将返回父级以“A”开头的所有记录，而不仅仅是父级等于A的记录。您将得到大量重复项，需要过滤掉，但您至少应该拥有所需的所有数据。

您可以发布数组的外观吗？我不太明白你所说的“它不能深入到产品结构的1层”是什么意思。

SQL

query

WHERE（（（Parent）='&ParentName&'））

仅返回一个父级的结果。在DB表的外观示例中，例如，

parent='A'

将位于前四行。当您删除

WHERE

并获取工厂的所有数据时，会发生什么情况？@Dee-工厂用作过滤器，以减少返回的记录数。用户将在父级中输入它em和他们想要制造的数量。我需要能够递归地跟踪产品结构，一直到原材料，这样我知道为了生产10件产品a，我需要10件A1，30件A2，10件A3A，10件A3B1，40件A3B2，10件A3B3，20件A4@J.Garth-数组是我在中填充的动态数组上面的代码（PPS（））我的想法是，我想创建一个类模块，将其称为“PS”，并在其中填充PPS（）数组，然后为产品结构中找到的每个子部件创建一个新的“PS”实例并存储产品结构的这一部分。问题是，我需要能够为“PS”类的每个实例动态创建变量名，因为我无法提前知道需要多少。显而易见的问题是

------ ShowAllData
Item: A, SubItem: A1, Value: 1
Item: A, SubItem: A2, Value: 3
Item: A, SubItem: A3, Value: 1
Item: A, SubItem: A4, Value: 2
Item: A3, SubItem: A3A, Value: 1
Item: A3, SubItem: A3B, Value: 1
Item: A3, SubItem: A3C, Value: 2
Item: A3, SubItem: A3D, Value: 1
Item: A3B, SubItem: A3B1, Value: 1
Item: A3B, SubItem: A3B2, Value: 4
Item: A3B, SubItem: A3B3, Value: 1
------ ShowData (A3)
Item: A3, SubItem: A3A, Value: 1
Item: A3, SubItem: A3B, Value: 1
Item: A3, SubItem: A3C, Value: 2
Item: A3, SubItem: A3D, Value: 1
------ ShowData (A3B2)
Item: A3B, SubItem: A3B2, Value: 4

Option Explicit

'In VBA Editor add a reference: Tools -> References -> Add Microsoft Scripting Runtime

Private Const SEP = "------ "

Public Sub ReadData()
    Const TLC = 2   'TLC = Top-level column (B: Parent)
    Dim ur As Variant, r As Long, ubR As Long, parents As Dictionary
    Dim lvl1 As String, lvl2 As String, lvl3 As String

    ur = Sheet1.UsedRange
    ubR = UBound(ur, 1)
    Set parents = New Dictionary
    parents.CompareMode = vbTextCompare  'or: vbBinaryCompare

    For r = 2 To ubR
        lvl1 = Trim(CStr(ur(r, TLC)))
        lvl2 = Trim(CStr(ur(r, TLC + 1)))
        lvl3 = Trim(CStr(ur(r, TLC + 2)))
        SetItms Array(lvl1, lvl2, lvl3), parents
    Next
    ShowAllData parents
    ShowData parents, "A3"
    ShowData parents, "A3B2"
End Sub

Public Sub SetItms(ByRef itms As Variant, ByRef parents As Dictionary)
    Dim ub As Long, subItms() As String, i As Long, children As Dictionary

    ub = UBound(itms)
    If ub > 1 Then
        ReDim subItms(ub - 1)
        For i = 1 To ub
            subItms(i - 1) = itms(i)
        Next
        If Not parents.Exists(itms(0)) Then
            Set children = New Dictionary
            children.CompareMode = vbTextCompare   'or: vbBinaryCompare
            SetItms subItms, children              '<-- recursive call
            parents.Add itms(0), children
        Else
            Set children = parents(itms(0))
            SetItms subItms, children              '<-- recursive call
        End If
    Else
        If Not parents.Exists(itms(0)) Then parents.Add itms(0), itms(1)
    End If
End Sub

Private Sub ShowAllData(ByRef itms As Dictionary)
    Dim l1 As Variant, l2 As Variant
    Debug.Print SEP & "ShowAllData"
    For Each l1 In itms
        For Each l2 In itms(l1)
            Debug.Print "Item: " & l1 & ", SubItem: " & l2 & ", Value: " & itms(l1)(l2)
        Next
    Next
End Sub

Private Sub ShowData(ByRef itms As Dictionary, ByVal itmName As String)
    Dim l1 As Variant, l2 As Variant, isParent As Boolean, done As Boolean
    Debug.Print SEP & "ShowData (" & itmName & ")"
    For Each l1 In itms
        isParent = l1 = itmName
        If isParent Then
            For Each l2 In itms(l1)
                Debug.Print "Item: " & l1 & ", SubItem: " & l2 & ", Value: " & itms(l1)(l2)
            Next
        End If
        If isParent Then Exit For
    Next
    If Not isParent Then
        For Each l1 In itms
            For Each l2 In itms(l1)
              done = l2 = itmName
              If done Then
                Debug.Print "Item: " & l1 & ", SubItem: " & l2 & ", Value: " & itms(l1)(l2)
                Exit For
              End If
            Next
            If done Then Exit For
        Next
    End If
End Sub

Row 1, Col 1:   --->   Plant
Row 1, Col 2:   --->   Parent
Row 1, Col 3:   --->   Component
Row 1, Col 4:   --->   NumberUsed
Row 1, Col 5:   --->   Test Col 1
Row 1, Col 6:   --->   Test Col 2
Row 1, Col 7:   --->   Test Col 3
Row 2, Col 1:   --->   Z
Row 2, Col 2:   --->   A
Row 2, Col 3:   --->   A1
Row 2, Col 4:   --->   1
Row 2, Col 5:   --->   E1
Row 2, Col 6:   --->   F1
Row 2, Col 7:   --->   G1
...
Row 12, Col 1:   --->   Z
Row 12, Col 2:   --->   A3B
Row 12, Col 3:   --->   A3B3
Row 12, Col 4:   --->   1
Row 12, Col 5:   --->   E11
Row 12, Col 6:   --->   F11
Row 12, Col 7:   --->   G11

Public Sub NestedList()
    Dim ur As Variant, itms As Dictionary, subItms As Dictionary
    Dim r As Long, c As Long, lr As Long, lc As Long

    ur = ThisWorkbook.Worksheets("Sheet1").UsedRange
    Set itms = New Dictionary
    itms.CompareMode = vbTextCompare   'or: vbBinaryCompare

    lr = UBound(ur, 1)
    lc = UBound(ur, 2)

    For r = 1 To lr
        Set subItms = New Dictionary
        itms.CompareMode = vbTextCompare
        For c = 1 To lc
            subItms.Add Key:=c, Item:=Trim(CStr(ur(r, c)))
        Next
        itms.Add Key:=r, Item:=subItms
        Set subItms = Nothing
    Next
    NestedListShow itms
End Sub

Private Sub NestedListShow(ByRef itms As Dictionary)
    Dim r As Long, c As Long
    For r = 1 To itms.Count
        For c = 1 To itms(r).Count
            Debug.Print "Row " & r & ", Col " & c & ":   --->   " & itms(r)(c)
        Next
    Next
End Sub