VBA очень медленный, когда словарь полон объектов

Question

У меня есть словарь со строковыми ключами и заполненный объектами. Эти объекты содержат словарь, а этот объект содержит три словаря. Это три слоя глубиной. Я использую Microsoft Scripting Runtime Dictionary Object.

Основной словарь строки / объекта -Object Содержит словарь (String, Object) --Древол объектов (строка, объект) --Древол объектов (строка, объект ) --Dictionary объектов (строка, объект)

Когда я закончу с заданием и код завершен, словарь будет установлен в ничто. Когда это происходит, Class_Terminate вызывается для каждого объекта в каждом из словарей. Это очень медленно, и у меня возникают проблемы с определением причины или обходного пути.

Я использую класс cTimer для измерения производительности.

Как мне повысить производительность завершения или пропустить прекратить операцию? Есть ли какая-то ошибка или работа с объектом словаря?

Кстати, это Excel 32bit.

Пример кода Воспроизведение медлительности Попробуйте изменить i на 1000 или 10000. :

Option Explicit

Sub TestFillAndDestroy()
    Dim c1 As Class1


    Dim myDict As Dictionary
    Set myDict = New Dictionary

    Dim i As Long
    For i = 1 To 100
        Set c1 = New Class1
        c1.Fill
        myDict.Add CStr(i), c1
    Next

    Set myDict = Nothing 'extremely slow!

End Sub

Класс 1

Option Explicit

Private mDictofClass2 As Dictionary


Private Sub Class_Initialize()
    Set mDictofClass2 = New Dictionary
    Fill
End Sub

Sub Fill()
    Dim c2 As Class2
    Set c2 = New Class2
    c2.Name = Format(mDictofClass2.Count, "0000000")
    Add c2
End Sub

Sub Add(aClass2 As Class2)
    mDictofClass2.Add aClass2.Name, aClass2
End Sub

Private Sub Class_Terminate()
    Set mDictofClass2 = Nothing
End Sub

Класс 2

Option Explicit

Private mDictOfClass3 As Dictionary
Private mName As String

Property Get Name() As String
    Name = mName
End Property

Property Let Name(inputName As String)
    mName = inputName
End Property

Private Sub Fill()
    Dim c3 As Class3
    Dim i As Long
    For i = 1 To 20
        Set c3 = New Class3
        c3.Name = Format(i, "00")
        Add c3
    Next
End Sub

Public Sub Add(aClass3 As Class3)
    mDictOfClass3.Add aClass3.Name, aClass3
End Sub

Private Sub Class_Initialize()
    Set mDictOfClass3 = New Dictionary
    Fill
End Sub

Класс 3

Option Explicit

Private mDictOfClass4 As Dictionary 'just a poco
Private mDictOfStrings As Dictionary
Private mDictOfDoubleArray As Dictionary
Private mName As String
Property Let Name(inputName As String)
    mName = inputName
End Property

Property Get Name() As String
    Name = mName
End Property

Private Sub Class_Initialize()
    Set mDictOfDoubleArray = New Dictionary
    Set mDictOfClass4 = New Dictionary
    Set mDictOfStrings = New Dictionary
    Fill
End Sub

Private Sub Fill()
    Dim i As Long
    Dim numbers(3) As Double
    numbers(0) = 0.00514
    numbers(1) = 654
    numbers(2) = 45.2587414
    Dim c4 As Class4
    Dim key As String
    For i = 1 To 150
        key = Format(CStr(i), "000")
        mDictOfDoubleArray.Add key, numbers
        mDictOfStrings.Add key & "v ggbbbnbb", "cvggpoiubvtgb  b vgflkjklj  nnnn"
        Set c4 = New Class4
        c4.Name = key
        mDictOfClass4.Add c4.Name, c4
    Next


End Sub

Класс 4

Option Explicit

Private d1 As Double
Private d2 As Double
Private d3 As Double
Private d4 As Double
Private d5 As Double
Private d6 As String
Private d7 As String
Private d8 As Double
Private d9 As Double
Private d10 As Double

Private t1 As String
Private t2 As String

Property Let Name(inputName As String)
    t1 = inputName
End Property

Property Get Name() As String
    Name = t1
End Property

Private Sub Class_Initialize()
    d1 = 1
    d2 = 2
    d3 = 5
    d4 = 15
    d5 = 1254
    d6 = 13654
    d7 = 1586
    d8 = 1985.55
    d9 = 985
    d10 = 6.14598
    t2 = "asdfdasgft34 scvg"
End Sub