Nooogg snellere code..

[robinvdveeken]

Geachte veelwetende,

Ik heb een dynamische invullijst gemaakt en deze word hier binnen het bedrijf inmiddels veelvuldig gebruikt. Door z'n eigen succes is deze lijst steeds verder gegroeit.
In kolom E t/m V worden voorwaarden geplaatst en afhankelijk wat er in de lijst zelf, kolom A t/m D word ingevuld worden er rijen verborgen.
De gebruikte rijen in de oorspronkelijke sheet zijn 140 t/m 750

De code is:

 Private Sub Worksheet_Change(ByVal Target As Range)
 
 Application.ScreenUpdating = False 'Voorkomt het knipperen van het scherm tijdens update
 
'Declaraties:
  Dim Rij As Integer, Kolom As Integer, Cel As Range
  Dim DoelCellen As Range
  Dim EindRij As Integer, EindKolom As Integer, TekstB As String, TekstC As String
  
'Beperk de Range tot de gebruikte Rijen en kolommen:
  EindRij = 700 'Sheets("Front").UsedRange.Rows.Count
  EindKolom = Sheets("Front").UsedRange.Columns.Count - 1
  
'Code:
  Set DoelCellen = Cells(1, 100)
  For Kolom = 6 To EindKolom Step 3
    Set DoelCellen = Union(DoelCellen, Range(Cells(140, Kolom), Cells(EindRij, Kolom)))
  Next Kolom
  Set DoelCellen = DoelCellen.SpecialCells(xlCellTypeConstants)
  For Each Cel In DoelCellen
    If Rows(Cel.Row).Hidden = False Then
      Rij = Cel.Row
      TekstB = LCase(Cells(Rij, 2)): TekstC = LCase(Cells(Rij, 3))
      If Cel.Offset(0, -1) = "<>" Then
            
      
      Rows(Cel.Offset(0, 1).Value).Hidden = LCase(Cel) <> TekstB And LCase(Cel) <> TekstC
      Else
        Rows(Cel.Offset(0, 1).Value).Hidden = (LCase(Cel) = TekstB Or LCase(Cel) = TekstC)
      End If
    End If
  Next Cel

Application.ScreenUpdating = True 'Update het scherm na verandering
End Sub

Bij een verandering duurt het nu zo'n 11 seconde voor de wijziging is doorgevoerd.

Kan dit sneller, wat moet er anders?

Alvast bedankt.


Groeten,
Robin

 

[Revolutionary]

Beste Robin,

Ik ben zeker geen expert op dit gebied, maar ik heb eens soortgelijke vraag gesteld. Ik had op een gegeven moment zoveel formules in excelbestand staan dat het soms wel een minuut duurde voordat alles wat doorgerekend.

Ik zie dat je al ScreenUpdating hebt uitgezet, je kan nog 2 functies tijdelijk uit zetten om het proces te versnellen, gebruik daarvoor

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual

' jouw VBA-code

    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic

In mijn situatie duurde de berekeningen nog ongeveer 10sec, dus 6x sneller. Andere optie is om een snellere laptop of pc aan te schaffen (maar daar was je zelf waarschijnlijk ook al opgekomen), want dat kan ook heel veel tijd schelen. Wellicht zijn er nog meer mogelijkheden, maar daar kunnen de experts op dit forum je vast wel mee helpen.

Succes!

Tim

 

[E v R]

Nog een gedachte,
gebruik een hulpkolom om daarin de/een waarde te zetten (adhv jouw voorwaardes) en filter hierop.

Plaats anders eens het bestandje of iets vergelijkbaars

 

[cow18]

zelfde idee als EVR, alleen zou ik daar een formule (somproduct of zo) neerzetten en dan op het resultaat van die kolom gaan verbergen/tonen.
Zonder voorbeeldje is dat echter moeilijk te verklaren

 

[robinvdveeken]

Bedankt voor de reacties.

Inmiddels heb ik gemerkt dat de code soms sneller is dan een andere keer.
Heeft dit simpelweg te maken met de rekenkracht van de computer in relatie tot andere actieve programma's?

In de bijlage het uitgeklede voorbeeld bestand.
Zoals je kan zien staan er rode cellen in. Deze zijn voor mogelijke uitbereiding en kunnen door een macro worden verborgen.

Alvast bedankt.


Groeten,
Robin

 

[cow18]

volgens mij moet je niet gans je werkblad aflopen, enkel die rij die je net gewijzigd hebt, dus 2 rijen toegevoegd

'Code:
  Set DoelCellen = Cells(1, 100)
  For Kolom = 6 To EindKolom Step 3
    Set DoelCellen = Union(DoelCellen, Range(Cells(140, Kolom), Cells(EindRij, Kolom)))
  Next Kolom
  Set DoelCellen = DoelCellen.SpecialCells(xlCellTypeConstants)
  [COLOR="red"]Set DoelCellen = Intersect(Target.EntireRow, DoelCellen)
  If DoelCellen Is Nothing Then Exit Sub[/COLOR]
  For Each Cel In DoelCellen