Question

我在分配父母方面遇到了一些困难。运行程序后的结果如下：

1   
    3
    Apple   
    3
    Orange  
2   
    3
    Apple   
    3
    Orange  
3
    3
    Apple   
    3
    Orange

理想的结果是：

1   
    1
    Apple   
    1
    Orange  
2   
    2
    Apple   
    2
    Orange  
3
    3
    Apple   
    3
    Orange

我不明白为什么Object的父级被分配给同一个Object，因为

Main.Child(PackerNum).Child(FruitName) = Layer2.Child(FruitName)

应该能够指定一个全新的

Layer2.Child(FruitName)

进入

Main.Child(PackerNum).Child(FruitName)

我哪里出错???

Sub Parent_Test()

Dim Main As SubTree
Dim Layer2 As SubTree

Set Main = New SubTree
Set Layer2 = New SubTree

Layer2.Child("Apple").Name = "Apple"
Layer2.Child("Orange").Name = "Orange"

For PackerNum = 1 To 3

    For Each FruitName In Layer2.Children

        Main.Child(PackerNum).Name = PackerNum
        Main.Child(PackerNum).Child(FruitName) = Layer2.Child(FruitName)
        Main.Child(PackerNum).Child(FruitName).Parent = Main.Child(PackerNum)

    Next FruitName

Next PackerNum

Print_SubTree Main, 0

End Sub


Function Print_SubTree(SubTree As SubTree, Optional ByVal LayerCount As Byte)
'This Function prints the SubTree Recursively

If SubTree.ChildrenCount = 0 Then
    If Not SubTree.Parent Is Nothing Then
        Debug.Print String(LayerCount, vbTab) & SubTree.Parent.Name
    End If
    Debug.Print String(LayerCount, vbTab) & SubTree.Name
Else
    If Not SubTree.Parent Is Nothing Then
        Debug.Print String(LayerCount, vbTab) & SubTree.Parent.Name
    End If
    Debug.Print String(LayerCount, vbTab) & SubTree.Name

    LayerCount = LayerCount + 1
    For Each Key In SubTree.Children

        Print_SubTree SubTree.Child(Key), LayerCount

    Next Key

End If

End Function

我的课程模块如下：

Private pChild As Object
Private pParent As SubTree

Public Name As String
Public InstanceName As String

Public Property Get Child(ByVal KeyString As Variant) As SubTree
    If Not pChild.Exists(KeyString) Then
        Dim objChild As New SubTree
        pChild.Add KeyString, objChild
    End If
    Set Child = pChild(KeyString)
End Property

Public Property Let Child(ByVal KeyString As Variant, ByVal objChild As SubTree)
    pChild.Add KeyString, objChild
End Property

Public Property Get Parent() As SubTree
    Set Parent = pParent
End Property

Public Property Let Parent(ByRef objParent As SubTree)
    Set pParent = objParent
End Property


Public Property Get Children() As Variant
    Children = pChild.Keys
End Property

Public Property Get ChildrenCount() As Variant
    ChildrenCount = pChild.Count
End Property


Private Sub Class_Initialize()
    Set pChild = CreateObject("Scripting.Dictionary")
    Set pName = CreateObject("Scripting.Dictionary")
End Sub

Private Sub Class_Terminate()
    Set pChild = Nothing
    Set pName = Nothing
End Sub

Answer 1

您在每种情况下都传递了相同的Layer2对象，因此您每次都会实际更改同一孩子的父级。要获得所需的输出，您需要在循环内部使用新的layer2对象 - 例如：

Sub Parent_Test()

Dim Main As SubTree
Dim Layer2 As SubTree

Set Main = New SubTree

For PackerNum = 1 To 3
    Set Layer2 = New SubTree

    Layer2.Child("Apple").Name = "Apple"
    Layer2.Child("Orange").Name = "Orange"

    For Each FruitName In Layer2.Children

        Main.Child(PackerNum).Name = PackerNum
        Main.Child(PackerNum).Child(FruitName) = Layer2.Child(FruitName)
        Main.Child(PackerNum).Child(FruitName).Parent = Main.Child(PackerNum)

    Next FruitName

Next PackerNum

Print_SubTree Main, 0

End Sub

将父级分配给Object

1 个答案: