VBA类方法从数组返回对象引用

时间:2016-12-01 14:34:03

标签: vba tree

我正在尝试构建一个对象树来引用一个层次结构的组织。我创建了一个Node类,它有一个costcenter属性和一个Node对象数组。

从根节点开始,每个节点都可以有一个子节点数组,它们本身可以有子节点数组。

我有这个方法,我想返回位于其父数组中的子对象的引用。它需要将它作为指针返回而不是对象的副本,因为我希望能够通过整个树从叶子导航到根。我收到此错误:运行时错误'91':对象变量或未设置块变量

有人会知道我错过了什么吗?

'Node Class Module
Option Explicit

Dim children() As Node
Private arraySize As Integer
Private costcenter As Long

Public Function addChild(child As Long)

On Error GoTo addChild_Error

If IsNull(arraySize) Then
arraySize = 0
End If

' increment the arraysize variable
arraySize = arraySize + 1

'redimension the array of one more space
ReDim Preserve children(arraySize + 1)

Dim i As Integer
i = arraySize - 1

Set children(i) = New Node

children(i).setCostCenter (child)

addChild_Exit:

Exit Function

addChild_Error:

Debug.Print Err.Source


End Function

Public Function getChildrenCount() As Integer

If Not IsNull(arraySize) Then
getChildrenCount = arraySize
Else
getChildrenCount = 0
End If

End Function

Public Function setCostCenter(cc As Long)

costcenter = cc

End Function

Public Function child(cc As Long) As Node

If arraySize > 0 Then

    Dim i As Integer

    For i = 0 To arraySize Step 1

        Debug.Print children(i).getCostcenter

        If children(i).getCostcenter = cc Then

        Debug.Print "found"

   'getting error on the next line
        Set child = children(i)

        End If    
    Next i
End If

End Function

在以下子程序中进行测试:

Public Sub testCCnodes()

Dim root As Node
Set root = New Node
'initiate root
root.setCostCenter (103100) 
'add first level
root.addChild (206680)
root.addChild (206010)
root.addChild (205480)
root.addChild (205290)

'testing addChild
Dim limit As Integer
limit = root.getChildrenCount() - 1

Dim i As Integer
For i = 0 To limit Step 1

Debug.Print root.getChild(i)

Next i

'add a second level
Dim str As String
With root.child(205290)    'getting error on this line

   .addChild (205460)
   .addChild (205450)
   .addChild (205400)

End With

End Sub

2 个答案:

答案 0 :(得分:2)

arraySize是一个整数。数值类型的初始值为0.数字类型永远不能为空。

  

如果IsNull(arraySize)则arraySize = 0 End If

增量计数

  

arraySize = arraySize + 1

Redim数组大于connter?

ReDim Preserve children(arraySize + 1)

设置对数组中第3个到最后一个元素的引用

  

i = arraySize - 1

     

设置children(i)= New Node

问题是你的反击是关闭的。

这是一个更简单的模式

Private Sub Class_Initialize()
    arraySize = -1
End Sub

Public Function addChild(child As Long)
    arraySize = arraySize + 1
    ReDim Preserve children(arraySize)

    Set children(arraySize) = New Node
    children(arraySize).setCostCenter (child)

End Function

答案 1 :(得分:2)

正如使用VBA-Collection的评论中所建议的那样,应该更加容易。例如:

  

节点类模块

Option Explicit

Private m_children As VBA.Collection
Private m_costcenter As Long

Private Sub Class_Initialize()
    Set m_children = New VBA.Collection
End Sub

Public Function AddChild(ByRef newChild As Node)
    m_children.Add newChild, CStr(newChild.Costcenter)
End Function

Public Property Get ChildrenCount() As Integer
    ChildrenCount = m_children.Count
End Property

Public Property Get Costcenter() As Long
    Costcenter = m_costcenter
End Property

Public Property Let Costcenter(ByVal vNewValue As Long)
    m_costcenter = vNewValue
End Property

Public Function Child(cc As Long) As Node
    Dim ch As Node
    For Each ch In m_children
        If ch.Costcenter = cc Then
            Set Child = ch
            Exit Function
        End If
    Next ch
    ' Note that this function can still return Nothing here
End Function
  

测试

Public Sub testCCnodes()
    Dim root As Node
    Set root = New Node
    root.Costcenter = 103100

    Dim newChild As Node
    Set newChild = New Node
    newChild.Costcenter = 205290
    root.AddChild newChild

    Set newChild = New Node
    newChild.Costcenter = 205460

    With root.Child(205290)
        .AddChild newChild
        ' and so on
        ' ...
    End With
End Sub