Question

我试图使用VBA扩展BOM树，但我已经进入了几天，我无法得到任何东西。

我有一张这样的表：

Parent  Component
A   A1
A   A2
A   A3
A   A4
A   A5
A1  A6
A1  A7
A1  A8
A1  A9

我想用VBA输出表格，如下所示： 1）

Level   Part
0   A
.1  A1
..2 A6
..2 A7
..2 A8
..2 A9
.1  A2
.1  A3
.1  A4
.1  A5

或2）

Level_0 Level_1 Level_2
A       
    A1  
        A6
        A7
        A8
        A9
    A2  
    A3  
    A4  
    A5

谢谢！

Answer 1

Option Compare Database
Option Explicit
Option Base 1
Public i As Long
Public myLevel(1000) As Long
Public myPart(1000) As Long



Sub test()

i = 1

Debug.Print 0 & Chr(9) & "A"
Extend_BOM_Structure ("A")



End Sub

Sub Extend_BOM_Structure(Part As String)



    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset

    Set cn = CurrentProject.Connection

    Dim mySQL As String

    mySQL = "SELECT Component FROM Table1 WHERE Parent = " & Chr(34) & Part & Chr(34)

    rs.Open mySQL, cn, adOpenForwardOnly, adLockBatchOptimistic

    With rs

        Do While Not .EOF

        Debug.Print 1 & Chr(9) & .Fields(0)

        Call Extend_BOM_Structure(.Fields(0))

        .MoveNext

        Loop

    End With

    Set rs = Nothing
    Set cn = Nothing

End Sub

但我不知道如何生成关卡编号。

以下是立即窗口输出：

Answer 2

我提出了一个粗略的想法，生成一级的数量，代码有点不聪明。任何人都可以帮我优化代码吗？

 Option Compare Database
Option Explicit
Option Base 1
Public i As Long

Sub test()
DoCmd.RunSQL "DELETE * FROM Table2"
DoCmd.RunSQL "DELETE * FROM Table3"
Debug.Print 0 & Chr(9) & "A"
Call WriteTable("0", "A")
Call WriteTable3("0", "A")
Extend_BOM_Structure_1 ("A")
End Sub

Sub Extend_BOM_Structure_1(Part As String)
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset
    Set cn = CurrentProject.Connection
    Dim mySQL As String
    Dim k As Long
    mySQL = "SELECT Component FROM Table1 WHERE Parent = " & Chr(34) & Part & Chr(34)
    rs.Open mySQL, cn, adOpenForwardOnly, adLockBatchOptimistic
    With rs
        Do While Not .EOF
            Debug.Print ".1" & Chr(9) & .Fields(0)
            Call WriteTable(".1", .Fields(0))
            Call WriteTable3(".1", .Fields(0))
            Call Extend_BOM_Structure_2(.Fields(0))
            .MoveNext
        Loop
    End With
    Set rs = Nothing
    Set cn = Nothing
End Sub

Sub Extend_BOM_Structure_2(Part As String)
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset
    Set cn = CurrentProject.Connection
    Dim mySQL As String
    mySQL = "SELECT Component FROM Table1 WHERE Parent = " & Chr(34) & Part & Chr(34)
    rs.Open mySQL, cn, adOpenForwardOnly, adLockBatchOptimistic
    With rs
        Do While Not .EOF
            Debug.Print "..2" & Chr(9) & .Fields(0)
            Call WriteTable("..2", .Fields(0))
            Call WriteTable3("..2", .Fields(0))
            Call Extend_BOM_Structure_3(.Fields(0))
            .MoveNext
        Loop
    End With
    Set rs = Nothing
    Set cn = Nothing
End Sub

Sub Extend_BOM_Structure_3(Part As String)
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset
    Set cn = CurrentProject.Connection
    Dim mySQL As String
    mySQL = "SELECT Component FROM Table1 WHERE Parent = " & Chr(34) & Part & Chr(34)
    rs.Open mySQL, cn, adOpenForwardOnly, adLockBatchOptimistic
    With rs
        Do While Not .EOF
            Debug.Print "...3" & Chr(9) & .Fields(0)
            Call WriteTable("...3", .Fields(0))
            Call WriteTable3("...3", .Fields(0))
            Call Extend_BOM_Structure_4(.Fields(0))
            .MoveNext
        Loop
    End With
    Set rs = Nothing
    Set cn = Nothing
End Sub

Sub Extend_BOM_Structure_4(Part As String)
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset
    Set cn = CurrentProject.Connection
    Dim mySQL As String
    Dim k As Long
    mySQL = "SELECT Component FROM Table1 WHERE Parent = " & Chr(34) & Part & Chr(34)
    rs.Open mySQL, cn, adOpenForwardOnly, adLockBatchOptimistic
    With rs
        Do While Not .EOF
            Debug.Print "....4" & Chr(9) & .Fields(0)
            Call WriteTable("....4", .Fields(0))
            Call WriteTable3("....4", .Fields(0))
            Call Extend_BOM_Structure_5(.Fields(0))
            .MoveNext
        Loop
    End With
    Set rs = Nothing
    Set cn = Nothing
End Sub

Sub Extend_BOM_Structure_5(Part As String)
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset
    Set cn = CurrentProject.Connection
    Dim mySQL As String
    Dim k As Long
    mySQL = "SELECT Component FROM Table1 WHERE Parent = " & Chr(34) & Part & Chr(34)
    rs.Open mySQL, cn, adOpenForwardOnly, adLockBatchOptimistic
    With rs
        Do While Not .EOF
            Debug.Print ".....5" & Chr(9) & .Fields(0)
            Call WriteTable(".....5", .Fields(0))
            Call WriteTable3(".....5", .Fields(0))
            .MoveNext
        Loop
    End With
    Set rs = Nothing
    Set cn = Nothing
End Sub

'/ *写入table2 Table3 /

Sub WriteTable(mylevel As String, myPart As String)
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset
    Set cn = CurrentProject.Connection
    rs.Open "Table2", cn, adOpenForwardOnly, adLockOptimistic
    DoCmd.SetWarnings False
    With rs
        .AddNew
        .Fields(0) = mylevel
        .Fields(1) = myPart
    End With
    rs.Update
    Set rs = Nothing
    Set cn = Nothing
End Sub

Sub WriteTable3(mylevel As String, myPart As String)
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset, _
                                    rs2 As New ADODB.Recordset
    Set cn = CurrentProject.Connection
    rs.Open "Table3", cn, adOpenForwardOnly, adLockOptimistic
    DoCmd.SetWarnings False
    With rs
        .AddNew
        .Fields(CInt(Right(mylevel, 1))) = myPart
    End With
    rs.Update
    Set rs = Nothing
    Set cn = Nothing
End Sub

以下是输出：

myLevel myPart
0   A
.1  A1
..2 A6
..2 A7
..2 A8
..2 A9
.1  A2
..2 B1
..2 B2
..2 B3
..2 B4
..2 B5
...3    C10
...3    C11
...3    C12
...3    C13
...3    C14
.1  A3
.1  A4
.1  A5

Level_0 Level_1 Level_2 Level_3 Level_4 Level_5
A                   
    A1              
        A6          
        A7          
        A8          
        A9          
    A2              
        B1          
        B2          
        B3          
        B4          
        B5          
            C10     
            C11     
            C12     
            C13     
            C14     
    A3              
    A4              
    A5

将二维表转换为树结构

2 个答案: