Ščitenje resursov v VBA III

V prejšnjem prispevku sem prikazal kako idejo o ščitenju realizirati v praksi, danes pa podajam še prvi konkretni primer, ki bo prikazal resnično uporabnost.

Hitrejše izvajanje makrov

Za hitrejše izvajanje makrov v Excelu je priporočljivo ustaviti preračunavanje, saj sicer Excel ob vsaki spremembi, ki bi vplivala na druge celice vse tiste celice preračunava in če to ponovimo 1000x se preračunavanje izvede 1000x!

Dobro je tudi preprečiti nepotrebno osveževanje ekrana, saj sicer uporabniku zaslon nenehno utripa in okna ter podatki skačejo sem ter tja.

Nenazadnje pa je dobro (če jih ne potrebujemo) izključiti tudi odzive na dogodke.

Vse skupaj lahko torej strnemo v sledečo kodo:

With Application
    .Calculation = xlCalculationManual  ' preprečimo preračunavanje
    .ScreenUpdating = False    ' ne osvežujemo ekrana
    .EnableEvents = False  ' ugasnemo dogodke
End With

Seveda pa je potrebno ob koncu makra vse to postaviti nazaj:

Sub VelikMakro()
  ' zamrznemo
  With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
  End With

  ' tu vmes je veliko kode

  ' vzpostavimo nazaj
  With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
  End With
End Sub

Test

A da bo stvar bolj zanimiva, izvedimo majhen test. Poglejmo kako dolgo se bo izvajal sledeč makro:

Sub TestnaFunkcija()
  Range("A1").Formula = "=cos(A2)*tan(A2)/sin(a3)"
  Range("A2").Formula = "=1/A3"

  Dim i As Long
  For i = 1 To 100000
    Range("A3") = i
  Next
End Sub

Sub KlicTestneFunkcije()
  TestnaFunkcija
End Sub

Sub IzvediTest()
  Dim cas: cas = Now
    KlicTestneFunkcije
  MsgBox "Trajanje (v sec): "; ((Now - cas) * 24 * 60 * 60)
End Sub

Če izvedem makro IzvediTest, se na testnem računalniku izvaja 19 sekund.

Objekt, ki bo vzpostavil stanje

Napišimo torej objekt, ki bo ob inicializaciji »zamrznil« Excel in ga ob koncu makra vzpostavil nazaj:

Option Explicit

Private Sub Class_Initialize()
  With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
  End With
End Sub

Private Sub Class_Terminate()
  With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
  End With
End Sub

Poimenujmo ga clsZamrzni.

Nov test

Popravimo sedaj funkcijo tako, da uporabimo pridobljeno znanje. Uporabimo torej objekt. Popravimo testni klic:

Sub KlicTestneFunkcije()
  Dim zamrzni As clsZamrzni

  Set zamrzni = New clsZamrzni
  TestnaFunkcija
End Sub

Če sedaj na mojem testnem računalniku izvedem funkcijo IzvediTest, se slednja izvede v manj kot sekundi… 😉

Komentirajte prispevek

This site uses Akismet to reduce spam. Learn how your comment data is processed.