Почему время, необходимое для стирания массива, не пропорционально количеству объектов в массиве - PullRequest
0 голосов
/ 11 июня 2019

Некоторое время назад я попросил быстрый связанный список, и совет заключался в использовании классов. ( Как создать минимальный связанный список Excel-VBA без использования пользовательских классов в VBA ). Я думал, что я должен пойти на это, и это работало нормально, пока я не начал увеличивать длину списка. Excel перестает отвечать на запросы после завершения программы.

Я проследил это до разрушения объектов. Приведенный ниже код измеряет время выполнения создания и уничтожения объектов «dumclass» (полностью пустой класс, без методов или свойств).

По сути, часы начинают тикать (тик). Я заполняю массив и коллекцию dumclasses, и, для сравнения, массив коллекциями. Я проверяю время (toc) и затем измеряю время, чтобы стереть массивы и коллекцию.

Похоже, что количество времени, которое требуется для "сбора мусора" объектов dumclasss после удаления массива / коллекции, увеличивается "экспоненциально" с числом объектов dumbclass в коллекции. Сборка мусора классов, хранящихся в коллекции, занимает в два раза больше времени, чем в массиве.

Однако сравните это с массивом сборок, где время для сбора мусора практически равно нулю.

data table of execution times

Я немного перечитал и нашел это (https://stackoverflow.com/a/777331/10312272), который ссылается на сборку мусора в .Net. Может быть, Excel использует аналогичную систему с большими и маленькими объектами? (Post Ask note: Я попытался разделить массивы в кусках, это не имело никакого значения в общем времени утилизации)

Мне было интересно, сталкивались ли с этим другие, и есть ли способ избежать длительного сбора мусора при использовании большого количества объектов?

большое спасибо

Option Explicit
Declare Function GetTickCount Lib "kernel32" () As Long

Sub odd()

   Dim Lengths
   Lengths = Array(10, 100, 1000, 3000, 10000, 63000, 100000, 300000)

   Dim Length, k, dt1, dt2, dt3, dt4, coll As Collection
   dp "length", "t.setup", "t.del coll", "t.del/cls", "t.del arr", "t.del/cls", "t.del arr", "t.del/collection"
   Dim a(), c()
   For Each Length In Lengths

      ReDim a(1 To Length)
      ReDim c(1 To Length)
      Set coll = New Collection
      tic
      For k = 1 To Length
         'create a collection of dum(my)classes
         coll.Add New dumclass

         'create an array of dum classes
         Set a(k) = New dumclass

         'create an array of colections
         Set c(k) = New Collection
         c(k).Add 3
         c(k).Add 3
         c(k).Add 3
      Next
      dt1 = toc

      'delete the collection of dumbclasses
      tic
      Set coll = New Collection
      dt2 = toc

      'delete the array of dumclasses
      tic
      Erase a
      dt3 = toc

      'delete the array of collections
      tic
      Erase c
      dt4 = toc

      dp Length, dt1, dt2, Int(dt2 * 1000 / Length) / 1000, dt3, Int(dt3 * 1000 / Length) / 1000, dt4, Int(dt4 * 1000 / Length) / 1000, "ms"
   Next
   dp "done"
End Sub


Private Sub dp(Optional a1 = "", Optional a2 = "", Optional a3 = "", Optional a4 = "", Optional a5 = "", Optional a6 = "", Optional a7 = "", Optional a8 = "", Optional a9 = "", Optional a10 = "", Optional a11 = "", Optional a12 = "")
    Debug.Print a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12
End Sub


Private Function tic(Optional passedSinceLastcall As Boolean = False)
   Static LastTime As Long, nU As Long
   nU = GetTickCount
   If passedSinceLastcall Then
      If LastTime = 0 Then
         tic = 0
      Else
         tic = nU - LastTime
      End If
   Else
      tic = nU
   End If
   LastTime = nU
End Function

Private Function toc()
   toc = tic(True)
End Function
...