Buna,

Am revenit cu ultima partea din seria Advanced Filter. Astazi vom parcurge sintaxa vba pentru Advanced Filter si vom vedea 3 exemple pentru aceasta optiune:

 

Sintaxa VBA Advanced Filter

In VBA Advanced Filter are urmatoarea sintaxa:

expression .AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)
  • expression  - este camp obligatoriu si reprezinta obiectul de tip Range din VBA. Pentru Advanced Filter, acesta poate fi o coloana, o regiune de celule sau o zona definita prin optiunea Named Range;
  • Action - prezinta actiunea care se doreste prin aplicarea Advanced Filter. Este un camp obligatoriu si poate fi xlFilterCopydatele sunt copiate intr-o zona definita sau xlFilterInPlacefiltrare in acelasi tabel;
  • CriteriaRange – in acest camp se scrie adresa regiunii in care sunt setate criteriile pentru filtrare. Acest camp este optional. Daca este omis, filtrarea se face fara criterii;
  • CopyToRangeacest camp se foloseste in cazul xlFilterCopy si se foloseste pentru a scrie adresa regiunii unde se doreste copierea datelor dupa filtare. Acest camp este optional.
  • Unique - Acest camp se foloseste atunci cand se doreste filtrarea inregistrarilor unice. Argumentele pot fi TRUE, atunci cand se doreste filtrarea unica si FALSE cand nu se doreste acest lucru. In mod implicit, campul este setat pe FALSE.

Filtrarea in acelasi tabel (Filter in place)

La fel ca in articolele anterioare am folosit acelasi tabel. Codul VBA folosit pentru filtrarea tabelului conform unor criterii este:

Public Sub FilterInPlace()

Worksheets(“Advanced filter”).Range(“A1:C29″).AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Worksheets(“Advanced filter”).Range(“F1:F2″)

End Sub

Deoarece nu doresc sa copiez datele in alt loc, nu am completat nimic la argumentul CopyToRange si la fel la Unique.

Pentru a usura elimarea filtrului, am creat si un buton (Clear filter) legat de un cod VBA:

Public Sub ClearFilter()

ActiveSheet.ShowAllData

End Sub

Copierea inregistrarilor filtrate conform unor criterii

Un alt exemplu pe care l-am realizat in VBA este copierea inregistrarilor unui tabel folosind Advanced Filter:

Public Sub CopyWithCriteria()

Dim LR As Integer

If Not IsEmpty(Worksheets(“Advanced filter”).Range(“H2″)) Then
LR = Worksheets(“Advanced filter”).Cells(Rows.Count, 8).End(xlUp).Row
Worksheets(“Advanced filter”).Range(“H2:I” & LR).ClearContents
End If

Worksheets(“Advanced filter”).Range(“A1:C29″).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Worksheets(“Advanced filter”).Range(“F1:F2″), _
CopyToRange:=Worksheets(“Advanced filter”).Range(“H1:I1″)

End Sub

Dupa cum vedeti, nu m-am oprit doar la folosirea sintaxei  Advanced Filter. Deoarece criteriul dupa care se realizeaza filtrarea se poate schimba in functie de nevoia utilizatorului, a fost nevoie sa introduc un mic cod pentru a evita situatiile in care se suprascrie tabelul copiat cu altul mai mic.

Pentru acest lucru am folosit sintaxa IF. De asemenea, am definit si o variabila LR de tip integer. Sintaxa IF verifica daca prima celula, in afara de titlu, din tabelul ine care sunt copiate datele este gol. Daca celula contine date, in LR este salvat numarul ultimului rand care contine date de pe coloana H. Apoi continutul celulelor aflate pe coloanele H si I de la randul 2 la randul salvat in LR, est sters.

Daca conditia de la IF este falsa nu se face nimic.

Copierea inregistrarilor unice dintr-o coloana

Ultimul exemplu pe care doresc sa vi-l prezint este copierea inregistrarilor unice dintr-o coloana. Cel mai des am nevoie de filtrarea unica pe coloana, dar daca se doreste pe mai multe coloane se foloseste aceeasi sintaxa cu modificarea regiunii de celule care se filtreaza.

Public Sub UniqueRecords()

Worksheets(“Advanced filter”).Range(“A1:A29″).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Range(“K1″), Unique:=True
End Sub

Cu acest exemplu finalizam seria de articole dedicate optiunii Advanced Filter. Va invit sa downloadati fisierul cu exemplele de la urmatorul link: Advanced filter. Nu uitati sa activati macro-urile inainte sa deschideti fisierul.


Print pagePDF page
Share on Facebook0Share on Google+0Email this to someone