Trage VBA code

[gummi]

Goeiemorgen,

Heb een probleempje met wat VBA codes in excel 2003. Het duurt namelijk vrij lang eer Excel deze code doorgewerkt heeft. Kon met de zoekfunctie hier even niets vinden.
(ter illustratie: iets van een halfuur op laptop dual core 1,83GHz met standaard 50% processorcap per proces [excel gebruikt max 50% van elk], 2 gig ram.)

Hieronder een voorbeeld:

Private Sub Worksheet_activate()
Answer = MsgBox("D Operator updaten? Duurt even.", vbYesNo)
If Answer <> vbYes Then Exit Sub
Application.ScreenUpdating = False
For i = 2 To 14000
If Cells(i, 10) <> "" Then Cells(i, 10).RowHeight = 12.75
If Cells(i, 10) = "" Then Cells(i, 10).RowHeight = 0
Next i
Application.ScreenUpdating = True
End Sub

In kolom 10 (J) staan doorgetrokken/filled 'als' formules van het soort: als(ander blad!H2="A";ander blad!H2;"")
[Behalve op rij 1, 1001, 2001 etc., waar met een tekstregel een nieuwe variabele wordt aangeduid waarna weer op rij 1002-2000 (als(ander_blad!H2="B";ander_blad!H2;"")) etc.]

Nu is mijn vraag, is het mogelijk om deze code sneller te laten runnen? Heb met F8 al kunnen constateren dat hij gewoon 14000x door dezelfde 2 regels code heen rost om tot het resultaat te komen.

Alvast bedankt!

 

[Wigi]

Wat staat er in kolom H op dat andere blad? Tekst? Of getallen?

 

[Wigi]

Wat staat er in kolom H op dat andere blad? Tekst? Of getallen?

Ah OK, tekst dus, want dezelfde cel wordt opgehaald.

 

[gummi]

Ah OK, tekst dus, want dezelfde cel wordt opgehaald.

Yup, hieronder de post die ik 5min voor je reply wou posten, totdat de wireless ging haperen. Hoop dat je er iets mee kan

(de reden waarom dit feest plaatsvindt is zodat ik formules en grafieken kan maken per variatie binnen de naam/product/datum variabelen.)

Wat staat er in kolom H op dat andere blad? Tekst? Of getallen?

In dit geval pure tekst (geen formule), de naam van de operator. =ALS(Data!$G263="J. Smit";Data!$G263;"") In Data! kolom G staan verscheidene namen. In dit geval:
Data!G263 = J. Smit


Heb in dezelfde werkmap 4 van deze werkbladen volgens hetzelfde principe, de andere hebben een kortere range van respectievelijk i = 2 to 12000, 2 to 9000 en 2 to 1000:

=ALS(Data!$B141="Product 1";Data!B141;"")
Data!B141 = Product 1

=ALS(EN(37987<=Data!H3;Data!H3<38353);2004;"")
Data!H3 = 22-1-2004 (celeigenschap werd na handmatige invoer automatisch datum, op standaard: 38008)

=Data!BA268
Data!BA268 = =ALS(AL268="";"";ALS($AV268=0;(-(AFRONDEN(AL268;3))/$AW268)+50%;(-(AFRONDEN(AL268;3))/-0,2)))

 

[Wigi]

ongeteste code

Private Sub Worksheet_activate()

    Dim rZichtbaar As Range
    Dim rngData As Range
    Dim rngAF As Range

    If MsgBox("D Operator updaten? Duurt al bij al toch niet te lang ;-)", vbYesNo) = vbYes Then

        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        
        Set rngData = Range("J2", Range("J" & Rows.Count).End(xlUp))
        
        With rngData
            .EntireRow.RowHeight = 12.75
            .AutoFilter Field:=1, Criteria1:="="
        End With
        
        Set rngAF = ActiveSheet.AutoFilter.Range

        On Error Resume Next
        Set rZichtbaar = rngAF.Offset(1).Resize(rngAF.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        If Not rZichtbaar Is Nothing Then
            Application.Intersect(rdata.SpecialCells(xlCellTypeFormulas, xlTextValues), rZichtbaar).EntireRow.RowHeight = 0
        End If
        
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic

    End If

End Sub

Wigi

 

[gummi]

Thanks! Hij werkte in ieder geval snel, maar:

        If Not rZichtbaar Is Nothing Then
        [B]Application.Intersect(rdata.SpecialCells(xlCellTypeFormulas, xlTextValues), rZichtbaar).EntireRow.RowHeight = 0[/B]
        End If

Daar kwam excel aanzetten met:

Fout 424 tijdens uitvoering:

Object vereist.

Heb het ook bij de andere sheets uitgetest, maar daar komt hij bij dezelfde fout uit. Weliswaar sneller, maar toch.

Symptomen in het sheet:

- alle betrokken rijnummers in het blauw,
- is kolom J leeg op een dropdownmenu in J2 na, waarin alle termen uit het sheet staan;
- en moest ik de titelblokkering op kolom A-B eraf halen voordat ik weer verticaal kon scrollen. Titelblokkering op alleen rij 1 trok ie wel. Bleef vast staan op het initiele beeld van rij 1-56 ondanks verplaatsen van de excelscrollbalk rechts/scrollen met touchpad.

In een kopie gebeurd ofc.

Waar kan dit aan liggen?

 

[Wigi]

Hang eens een bestandje bij met:

- slechts 1 tabblad met IF functies
- slechts 1 tabblad waaruit gegevens gehaald worden
- in de toestand waarbij jij begint te testen
- enkel de eerste 100 rijen of zo (wel met nepdata).

Wigi

 

[gummi]

Zal ik binnenkort even doen, heb het van 70MB naar 1,5MB gekregen, nu nog naar 100kb.

 

[Wigi]

70MB

:shocked:

Door al die 1000-en formules wellicht.

Kan je geen draaitabel gebruiken ipv al die formules?

 

[gummi]

:shocked:

Door al die 1000-en formules wellicht.

Kan je geen draaitabel gebruiken ipv al die formules?

Het punt is dat ik het direct doorgelinkt wil hebben, dwz als er in het Data sheet iets veranderd, passen de 'D verwerkingssheets' zich nu gelijk aan en veranderen de grafieken en eindberekeningen in de resultaatsheets ook gelijk. Voor veranderingen in de zin van nieuwe dataregels zijn die VBA codes nodig. Die verwerkingssheets zijn berekend op een data-omvang van ~3,5x het huidige; de meeste cellen daar hebben eindwaarde "".

Voor zover ik weet gaat het niet lukken om doorgelinkte grafieken te hebben als er draaitabellen in de pijplijn zitten.

Het zijn inderdaad de paar bladen met 1000en formules, een tiental andere werkbladen met o.a 100en grafieken zijn in totaal ~ 4MB.

 

[Wigi]

Het punt is dat ik het direct doorgelinkt wil hebben, dwz als er in het Data sheet iets veranderd, passen de 'D verwerkingssheets' zich nu gelijk aan

Met een regeltje of 3 code kan je draaitabellen updaten bij het activeren van een sheet. Uiteindelijk is dit activeren ook wat je nu doet (naar het andere blad gaan).

Wigi

 

[gummi]

Heb daarna echter wel grafieken gelinkt aan die sheets, als in
reeks 1 'D als formules'!K2:K1000
reeks 2 'D als formules'!L2:L1000

en berekeningen, stdevp('D als formules'!K2:V1000), stdevp('D als formules'!K1002:V2000).

Bijgevoegd een bestand waar een ruim deel van de data uitgehaald is, weet niet of je met dit beperkte voorbeeld nog veel kan


edit: bij medium beveiliging krijg je de macro pop-up, er zit een stukje code in beide sheets, die in de 2e sheet is de wigi code. In de 1e sheet staat:

Private Sub Worksheet_change(ByVal Target As Range)
If Not Intersect(Target, Range("B2:B990")) Is Nothing Then
If Target <> "" Then Target.Offset(1, 0).RowHeight = 12.75
If Target = "" And Target.Offset(1, 0) = "" Then Target.Offset(1, 0).RowHeight = 0
If Target = "" And Target.Offset(-1, 0) = "" Then Target.RowHeight = 0
End If
End Sub

EDIT: opgelost omdat bleek dat alleen het uitschakelen van de berekening (Application.Calculation = xlCalculationManual/Automatic) de bewerkingstijd al kortte van ruim een halfuur naar een seconde of 5 á 10. En dat is meer dan genoeg bezuiniging. Bedankt voor de moeite in ieder geval.