Filteren via VBA

[dominiekO]

Beste helpers,

Ik heb een bestand met drie tabbladen (maakt deel uit van een nog groter bestand).

Op blad "lijst" worden gegevens ingevuld.

Door middel van de ingevulde postcode wordt een nummer toegekend per provincie.

Op het tweede blad kan je dan een provincie aanklikken.

Dan wordt op het derde blad alle projecten uit die provincie weergegeven.

Het werkt perfect, alleen als ik de formules doortrek (van blad Per provincie) tot bv rij 2000 dan neemt de berekening toch wel wat tijd in beslag.

Graag zou ik de formules vervangen door een VBA code, in de hoop dat deze vlugger gaat, als deze niet vlugger gaat, geen probleem, maar dan gaat hij ook niet altijd de cellen gaan herberekenen, wat ook een voordeel is.

De formule heb ik van het net geplukt(en aangepast), net zoals alle VBA codes voor de macro's (ben een echte leek in VBA).

Bestand zit in bijlage.Bekijk bijlage Kasten.rar

 

[Gert Bouwmeeste]

Ik heb deze macro voor je gemaakt. Andere insteek, via filteren op het tabblad Lijst en dan kopieren naar het tabblad per provincie. Werkt tot 30.000 regels even snel.

Sub Nieuw2()

    Application.ScreenUpdating = False 'Zet het scherm uit
    
    
    Range("A5:A30000").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="5"  'Filteren op waarde 5 in kolom A
    Range("B8").Select
    Range("B8:O65536").Select
    Selection.Copy
    Sheets("Per provincie").Select
    Range("B5").Select
    ActiveSheet.Paste
    ActiveSheet.Previous.Select
    ActiveSheet.Previous.Select
    Application.CutCopyMode = False
    ActiveSheet.ShowAllData
    Selection.AutoFilter
    Range("B8").Select
    ActiveSheet.Next.Select
    ActiveSheet.Next.Select
    
    Application.ScreenUpdating = True 'laat het scherm weer zien
    
End Sub

Gewoon opgenomen met de macrorecorder, code kan veel korter/netter zonder SELECT etc, maar 't is een aanzet.

Suc6

 

[WHER]

Iets andere aanpak.

 

[HSV]

Of jouw codes aanpassen.
Deze is alleen voor Brussel.

Sub Brussel()
'
' Macro4 Macro
' De macro is opgenomen op 15/03/2011 door Dominiek Osaer (ELS NV).
'
Sheets("Per provincie").Activate
ActiveSheet.Unprotect
Range("B5:N" & Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
Range("A19") = "1"

Dim cl
With Sheets("Lijst")
For Each cl In .Range("A6:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
If cl.Value = Range("A19").Value Then
[B65536].End(xlUp).Offset(1).Resize(, 13) = .Range(.Cells(cl.Row, 2), .Cells(cl.Row, 14)).Value
End If
Next
End With
Application.Goto Range("A1")
Application.MaxChange = 0.001
ActiveWorkbook.PrecisionAsDisplayed = False
Calculate
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 

[Warme bakkertje]

Eentje met uitgebreid filter.

 

[dominiekO]

Fantastisch,

Werkt perfect.

Bedankt.