class - 在 VBA 中释放递归类模块

Question

我一直在研究一个类模块，它包含自身的多个版本以构建树结构。

我注意到构建树的过程非常快。对于每棵子树有 6-8 个分支的 7 级树，大约需要 2 秒。不幸的是程序运行很慢。这好像是树使用的内存释放导致的，至少需要60秒。

最初我没有发布类模块，让VB在程序结束时发布，但是用set myTree = nothing代替这个对速度没有影响。

我还尝试编写一个子例程来破坏树。这递归地遍历每一层并将子树设置为空。奇怪的是，这似乎节省了大约 0.5 秒，但并不重要。

还有什么我可以做的来减少卸载时间吗？

代码确实很长，但下面的摘录给出了思路。我很高兴树结构有效，但最后两个计时器语句之间的差距非常大

Class treeNode
     private aCurrentDepth as integer
     private aNodeObject as myObject
     private aNodes(maxNodeCount) as treeNode
end class

public function creatreTree(m as myObject,depth as integer) as treeNode
     Dim x As Integer

     Set createTree = New treeNode
     createTree.initialise

     createTree.cNodeObject = m
     createTree.cCurrentDepth = depth

     If depth <> 1 Then
          For x = 0 To maxNodeCount
                createTree.tNode(x) = createTree(getObject(m,x), depth - 1)
          Next x
     End If
end function

sub testTree
    Dim t as treeNode
    dim g as myObject
    Set t = New treeNode

    g.initialise
    t.initialise

    set g = startObject

    Cells(1, "A") = Timer
    Set t = createTree(g, 7)
    Cells(1, "B") = Timer
    Set t = Nothing
    Cells(1, "C") = Timer
end sub

Answer 1

我上周刚刚创建了一个 debugExcelLog 类。您可能会发现跟踪类里面发生的事情很有帮助。我用它来定位一个偶尔发生的错误。 (原来 UserRoutine2 试图使用 UserRoutine1 正在清理的全局类。)

'------------------------------------------------------------------------------
'| Class Name: debugExcelLog
'| Programmer: Mischa Becker
'|       Date: 11/4/2011
'|    Purpose: Creates an Excel Workbook log
'------------------------------------------------------------------------------
'| Notes:
'|   + Add a DEBUG_PROJECT compiler constant to your project
'|   + Add Public Const g_PROJECT_NAME As String = "[ProjectName]" to a module.
'|   + sName and sCalledBy are expected to be in one of the following formats:
'|             Project.Class.Routine
'|             Class.Routine
'|             Routine
'------------------------------------------------------------------------------
Option Explicit

Private Const m_CLASS_NAME As String = g_PROJECT_NAME & ".debugExcelLog"
Private Const m_OFFSET As Integer = 3

Private m_wbk As Workbook
Private m_r As Range
Private m_bLogged As Boolean
Private m_iIndent As Integer
Private m_bOkToLog As Boolean
Private m_lInstanceID As Long
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
Private Sub Class_Initialize()
   m_bOkToLog = False
   m_lInstanceID = CLng(Rnd * 10 ^ 6)
   #If DEBUG_PROJECT Then
      Debug.Print m_CLASS_NAME; ".Class_Initialize", "Id:"; m_lInstanceID
      Me.TurnOn
   #End If
End Sub

Private Sub Class_Terminate()
   If Not (m_bLogged Or m_wbk Is Nothing) Then
      m_wbk.Close False
   End If
   Set m_wbk = Nothing
   Set m_r = Nothing
   #If DEBUG_PROJECT Then
      Debug.Print m_CLASS_NAME; ".Class_Terminate", "Id:"; m_lInstanceID
   #End If
End Sub
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
Public Sub TurnOn()
   Set m_wbk = Application.Workbooks.Add
   Set m_r = m_wbk.Sheets(1).Range("A1")
   m_iIndent = 0
   SetTitle
   m_bOkToLog = True
End Sub

Public Sub TurnOff()
   m_bOkToLog = False
End Sub
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
Public Sub Log_Start(sName As String, lInstance As Long _
, Optional sCalledBy As String = "" _
, Optional sComment As String = "")
   Const MY_NAME As String = m_CLASS_NAME & ".Log_Start"
   On Error GoTo ErrorHandler

   If Not m_bOkToLog Then Exit Sub

   m_bLogged = True
   m_iIndent = m_iIndent + 1

   BreakApartAndLogName sName, ".Start"
   Instance = lInstance
   TimeStamp = Now
   CalledBy = sCalledBy
   Comment = sComment

   MoveNextRow

   Exit Sub
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Sub

Public Sub Log_End(sName As String, lInstance As Long _
, Optional sCalledBy As String = "" _
, Optional sComment As String = "")
   Const MY_NAME As String = m_CLASS_NAME & ".Log_End"
   On Error GoTo ErrorHandler

   If Not m_bOkToLog Then Exit Sub

   BreakApartAndLogName sName, ".End"
   Instance = lInstance
   TimeStamp = Now
   CalledBy = sCalledBy
   Comment = sComment

   MoveNextRow

   m_iIndent = m_iIndent - 1

   Exit Sub
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Sub

Public Sub Log_Other(sName As String, lInstance As Long _
, Optional sCalledBy As String = "" _
, Optional sComment As String = "")
   Const MY_NAME As String = m_CLASS_NAME & ".Log_Other"
   On Error GoTo ErrorHandler

   If Not m_bOkToLog Then Exit Sub
   m_bLogged = True
   If m_iIndent < 0 Then m_iIndent = 0

   BreakApartAndLogName sName
   Instance = lInstance
   TimeStamp = Now
   CalledBy = sCalledBy
   Comment = sComment

   MoveNextRow

   Exit Sub
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Sub
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
Private Sub SetTitle()
   Const MY_NAME As String = m_CLASS_NAME & ".SetTitle"
   On Error GoTo ErrorHandler

   m_r = "Debug Excel Log Created on " & Date
   MoveNextRow
   Project = "Project"
   Module = "Module"
   Routine = "Routine"
   Instance = "Instance"
   TimeStamp = "TimeStamp"
   CalledBy = "Called By"
   Comment = "Comment"
   With Range(m_r, m_r.End(xlToRight))
      .Font.Bold = True
      .BorderAround XlLineStyle.xlContinuous, xlMedium
   End With
   MoveNextRow
   m_iIndent = -1

   Exit Sub
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Sub

Private Sub MoveNextRow()
   Set m_r = m_r.Offset(1)
End Sub

Private Sub BreakApartAndLogName(ByVal sName As String _
, Optional sExtra As String = "")
   Const MY_NAME As String = m_CLASS_NAME & ".BreakApartAndLogName"
   On Error GoTo ErrorHandler

   Routine = SplitOffLastSection(sName) & sExtra
   If Len(sName) > 0 Then
      Module = SplitOffLastSection(sName)
      If Len(sName) > 0 Then
         Project = SplitOffLastSection(sName)
      End If
   End If

   Exit Sub
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Sub

Private Function SplitOffLastSection(ByRef sName As String) As String
' Passed sName is returned without the Last Section.
   Const MY_NAME As String = m_CLASS_NAME & ".SplitOffLastSection"
   Dim i As Integer

   i = InStrRev(sName, ".")
   If i > 0 Then
      SplitOffLastSection = Mid(sName, i + 1)
      sName = Left(sName, i - 1)
   Else
      SplitOffLastSection = sName
      sName = ""
   End If

   Exit Function
ErrorHandler:
   Debug.Print MY_NAME, Err.Number; " - "; Err.Description
   Stop
   Resume
End Function
'------------------------------------------------------------------------------

'------------------------------------------------------------------------------
Private Property Let Project(sText As String)
   m_r = sText
End Property
Private Property Get Project() As String
   Project = m_r.Text
End Property

Private Property Let Module(sText As String)
   m_r.Offset(0, 1) = sText
End Property
Private Property Get Module() As String
   Module = m_r.Offset(0, 1).Text
End Property

Private Property Let Routine(sText As String)
   If m_iIndent < 0 Then
      m_r.Offset(0, 2) = sText
   Else
      m_r.Offset(0, 2) = Space(m_OFFSET * m_iIndent) & sText
   End If
End Property

Private Property Let Instance(lInstance As Variant)
   m_r.Offset(0, 3) = lInstance
End Property

Private Property Let TimeStamp(dTimeStamp As Variant)
   m_r.Offset(0, 4) = dTimeStamp
End Property

Private Property Let CalledBy(ByVal sText As String)
   ' remove Project and Module from sText if same as running Routine
   sText = Replace(sText, Project & "." & Module & ".", "")
   sText = Replace(sText, Project & ".", "")
   m_r.Offset(0, 5) = sText
End Property

Private Property Let Comment(sText As String)
   m_r.Offset(0, 6) = sText
End Property
'------------------------------------------------------------------------------

使用:

1. 将类添加到您的项目并将其命名为debugExcelLog
2. 将 DEBUG_PROJECT=-1 作为条件编译器常量添加到您的项目中
3. 创建类的全局变量。即 Public g_XlLog As debugExcelLog

4. 可以使用

   打开和关闭日志记录

   g_xlLog.TurnOn
   g_xlLog.TurnOff
   

   如果DEBUG_PROJECT为True，则不需要调用TurnOn，类会在初始化时自动开启。

5. 在您要跟踪的任何例程中使用以下内容。

   g_XlLog.Log_Start "[Class.Routine]", m_lInstanceIdOrZero
   g_XlLog.Log_Other "[Class.Routine]", m_lInstanceIdOrZero, ,"Comment"
   g_XlLog.Log_End   "[Class.Routine]", m_lInstanceIdOrZero
   

6. 我建议按如下方式更改您的 testTree。

   sub testTree
       Dim t as treeNode, g as myObject
       Dim iLevel as Integer
   
       iLevel = 7
       Set g_XlLog = New debugExcelLog
   
       g_XlLog.Log_Start "testTree", 0, , "Initializing test variables"
   
       Set t = New treeNode
       g.initialise
       t.initialise
   
       set g = startObject
   
       g_XlLog.Log_Other "testTree", 0, , "Create a " & iLevel & " level tree"
       Set t = createTree(g, iLevel)
       g_XlLog.Log_Other "testTree", 0, , "Terminate a " & iLevel & " level tree"
       Set t = Nothing
       g_XlLog.Log_End "testTree", 0
   
       set g_XlLog = Nothing
   
   end sub
   

我建议为 treeNode 和 MyObject 添加日志记录到 Class_Initialize 和 Class_Terminate。如果 Class_Terminate 正在调用其他例程，您可以向它们添加日志记录，或者使用 Log_Other 来跟踪每个例程何时开始。

如果您还没有这样做，我真的建议您将某种实例 ID 添加到 treeNode，以便您知道正在创建\终止哪个实例。如果您不担心 Rnd 创建重复的 ID，它可以像我在上面的类(class)中一样简单。

您还会注意到可选的 sCalledBy 和 sComment 参数。 sComment 应该很明显，但 sCalledBy 在那里，因为 Excel VBE 的调用堆栈还有很多不足之处。出于调试目的，我的一些方法需要调用它们的例程将它们的名称作为参数传递。如果您有此信息，可以将其发送给记录器。

一旦您对减速发生的位置有了更准确的了解，就会更容易找出解决方法。