Počasno izvajanje makroja

[kh]

Pozdravljeni,
spodaj navedeni makro potrebuje približno 50 sekund za izvedbo. Dodal sem mu del, ki sem ga našel na forumu, da ne osvežuje rezultatov med samim izvajanjem, pa sem vseeno na 50-ih sekundah. Ali mi zna kdo pomagati, kako bi se dalo zadevo pospešiti.


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

' naziv worksheeta znotraj workbooka
' RowCoors - koliko stevil ima koordinata vrstice
' ColCoors - koliko stevil ima koordinata stolpca
' Rows - koliko vrstic pregledujemo
' Cols - koliko stolpcev pregledujemo
' TargetRowN = Rows + ColCoors + 2 ' v kateri vrstici zacnemo izpisovati rezultat

Dim TargetRowN As Integer
TargetRowN = 2
Worksheets("Baza pivot").Select
Rows("2:65536").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Selection.Delete Shift:=xlToLeft

Call SerializeWorkSheet("Knjiženje1", "Baza pivot", 15, 8, 3000, 240, TargetRowN)
Call SerializeWorkSheet("Knjiženje2", "Baza pivot", 15, 8, 3000, 240, TargetRowN)
Call SerializeWorkSheet("Knjiženje3", "Baza pivot", 15, 8, 3000, 241, TargetRowN)

With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

Sub SerializeWorkSheet(FromWorkSheetNm As String, ToWorkSheetNm As String, RowCoors As Integer, ColCoors As Integer, Rows As Integer, Cols As Integer, ByRef TargetRowN As Integer)
For ColN = RowCoors + 1 To Cols + RowCoors
For RowN = ColCoors + 1 To Rows + ColCoors
If Worksheets(FromWorkSheetNm).Cells(RowN, ColN).Value <> "" Then
For RowCoorN = 1 To RowCoors
Worksheets(ToWorkSheetNm).Cells(TargetRowN, RowCoorN).Value = _
Worksheets(FromWorkSheetNm).Cells(RowN, RowCoorN).Value
Next RowCoorN
For ColCoorN = 1 To ColCoors
Worksheets(ToWorkSheetNm).Cells(TargetRowN, RowCoors + ColCoorN).Value = _
Worksheets(FromWorkSheetNm).Cells(ColCoorN, ColN).Value
Next ColCoorN
Worksheets(ToWorkSheetNm).Cells(TargetRowN, RowCoors + ColCoors + 1).Value = _
Worksheets(FromWorkSheetNm).Cells(RowN, ColN).Value
TargetRowN = TargetRowN + 1
End If
Next RowN
Next ColN

End Sub


Hvala in lep pozdrav
KH

[admin]

in v kakšnem času bi vi želeli da se to izvede... Če pogledam vašo kodo, se zagotovo strinjava, da se večino časa izvajajo funkcije SerializeWorkSheet. Imate tri klice te funkcije! Znotraj funkcije imate dve zanki, ki prečešeta celotno tabelo. Kolikokrat se zanki izvedata, je navedeno v parametrih Rows in Cols.

Pa poglejva:
Prvi klic povzroči, da se notranja zanka izvede (3000*240) krat, enako drugi, tretji pa še 3000x več. Zanka se torej izvede: 2*3000*240 + 3000*241 = 2.163.000

Znotraj vsake zanke imate najprej IF stavek, ki povzroči dobrih 2 miliona dostopov do celic, ki jih primerjate z prazno vrednosti. V kolikor celice niso prazne pa se zakadite v nove zanke in znotraj imate zopet zanki, ki se izvedeta 3000x in 240x, pri tem pa dostopata do dveh celic (izvorne in ponorne).

Podatki so torej sledeči:

Koda: Izberi vse

če je polnih % celic               ocena števila dostopov do celic
      100%               2.163.000 +  2.163.000 * (3000 + 240) * 4       = 28.034.643.000
       50%               2.163.000 + (2.163.000 * (3000 + 240) * 4) * .5 = 14.018.403.000
       10%               2.163.000 + (2.163.000 * (3000 + 240) * 4) * .1 = 2.805.411.000

V primeru da imate polnih samo(!) 10% celic mora Excel izvesti slabe 3 MILIJARDE dostopov do celic, v najslabšem primeru celo 30 MILIJARD dostopov.... in to naredi v 50 sekundah.... pa niste zadovoljni :(

No ja; lahko pa investirate denar v kakšen super računalnik, ki bi to izvedel v desetinki sekunde... No je pa problem, ker na superračunalnikih ni Excela