Question

我的问题：

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

产品A使用以下组件

A1
A2
A3
A4

但是组件A3可以是具有其自身产品结构的子组件，该组件需要被拉动。因此，我最终会得到产品A的完整产品结构，如下所示：

A用途：

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

等等。

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

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

Answer 1

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

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

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

版本1

输出：

------ 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

版本1有两个主要程序

从Sheet1读取所有行的文件：ReadData()
第二个按行生成嵌套字典（递归）：SetItms()
- col B（父母） - lvl 1 - 这些项目是顶级词典中的键
- col C（组件） - lvl 2 - 顶级词典的值和子词典的键
- col D（NumberUsed） - lvl 3 - 每个子词典中的值

这使用字典，后期绑定很慢： ~~CreateObject（＆＃34; Scripting.Dictionary＆＃34;）~~

早期绑定很快：VBA编辑器 - ＆gt; 工具 - ＆gt; 参考文献 - ＆gt;添加 Microsoft Scripting Runtime

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

接下来的2个潜点仅用于输出词典中的数据：ShowAllData()和ShowData()

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

版本2

输出：

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

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

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

注意：

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

Answer 2

我怀疑问题在于您正在寻找您的大型机数据库，就像它是一个关系数据库一样。但根据您提供的示例表，它不是。该表未正常化。

所以我在你的SQL查询中猜测，

"SELECT Component, NumberUsed FROM ProdStructMstr WHERE (((Parent)='" & ParentName & "') AND ((Plant)='" & Plt & "')) ORDER BY Component;"

Parent可能等于“A”，因此您返回的记录集仅包含组件A1，A2，A3和＆amp; A4。

如果是这种情况，那么您需要更改SQL查询以使用Like关键字，如下所示（您可能需要调整语法）

"SELECT Component, NumberUsed FROM ProdStructMstr WHERE (((Parent)=Like '" & ParentName & " *') AND ((Plant)='" & Plt & "')) ORDER BY Component;"

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

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

2 个答案: