Excel VBA i aktywne (realtime) filtrowanie ListBox/ComboBox

maj 7th, 2010. Komentarzy: 2.
Kategorie: Excel, Software, Visual Basic, Zabawy z kodem.

Jak już wspominałem onegdaj, bywa w życiu każdego PHPowca taki moment, kiedy staje przed koniecznością napisania makra w Excelowym VBA… Nie, wróć… to chyba tylko ja tak mam. W każdym razie – czasem trzeba. Dzisiejszy odcinek poświęcimy aktywnemu filtrowaniu listy. Jak toto wygląda, każdy powinien wiedzieć. Otóż jest sobie lista As ListBox oraz pole As TextBox. I w trakcie wpisywania czegoś do pola chcemy mieć na liście tylko te wartości, które pasują do wartości pola…

Trik polega na tym, że po załadowaniu całej listy, należy ją skopiować do tablicy, a następnie owej tablicy używać jako punktu odniesienia.

Oczywiście zwykłe filtrowanie byłoby zbyt proste (iterowanie tablicy i sprawdzanie, czy coś Like coś_innego, jeśli tak, dodawanie do listy). Dlatego postanowiłem przedstawić tu uniwersalny sposób filtrowania, dla dowolnej ilości list i pól tekstowych na aktywnej UserForm.

Do dzieła. Najpierw należy zadeklarować zmienną, w której przechowywać będziemy kopię naszej listy:

Public tmpList() As String

Ja na wszelki wypadek stworzyłem sobie tablicę globalną, jakbym chciał jeszcze gdzieś ją wykorzystać.

WAŻNE: W Excelowym VBA zmienne globalne Public deklarujemy w przestrzeni wolnej (nie wewnątrz żadnej funkcji/prodcedury) w module.

Należy też zauważyć, że funkcje zapisujące i filtrujące są uniwersalne, ale backup każda lista powinna mieć osobny.

Zakładam, że mamy już utworzony obiekt filtrowany ListBox oraz filtrujący TextBox. Nazwijmy je… jak chcemy :)
Po wypełnieniu listy, należy stworzyć we wspomnianej tablicy jej kopię zapasową:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

Sub saveList(myList As MSForms.ListBox, myBackup() As String)
    'na początek zmiana rozmiaru tablicy...
    ReDim myBackup(0 To myList.ListCount - 1, 0 To myList.ColumnCount - 1)
 
    'zauwazmy, ze funkcja bedzie dzialac dla dowolnej ilosc kolumn listy
    For a = LBound(myBackup, 1) To UBound(myBackup, 1)
        For b = LBound(myBackup, 2) To UBound(myBackup, 2)
            If Not IsNull(myList.List(a, b - LBound(myBackup, 2))) Then
                myBackup(a, b) = myList.List(a, b - LBound(myBackup, 2))
                'konstrukcja "b - LBound(myBackup, 2)" zabezpiecza przez 
                'innym indeksem początkowym tablicy zapasu
            End If
        Next
    Next
End Sub

UWAGA 1: jak powszechnie wiadomo, obiekty przekazywane są do funkcji domyślnie przez referencję, więc możemy sobie odpuścić ByRef w deklaracji argumentów funkcji.
UWAGA 2: deklaracja argumentu jako myList As ListBox nie powiedzie się. W Excelowym VBA są dwa rodzaje obiektów typu ListBox, nam chodzi o ten, który znajduje się w MSForms.
UWAGA 3: oczywiście wywołujemy funkcję bez nawiasów saveList myListBox1, tmpList

Doskonale, mamy listę z danymi, mamy też jej zapas. Co dalej? Ano funkcja filtrująca. Jest ona żenująco prosta:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

Sub filterList(myList As MSForms.ListBox, myTextBox As MSForms.TextBox, myBackup() As String)
    myList.Clear
 
    If myTextBox.Text = "" Then
        ' zapobiegamy dublowaniu wartosci
        For a = LBound(myBackup, 1) To UBound(myBackup, 1)
            myList.AddItem (myBackup(a, LBound(myBackup, 2)))
            For b = LBound(myBackup, 2) + 1 To UBound(myBackup, 2)
                myList.List(a, b - LBound(myBackup, 2)) = myBackup(a, b)
            Next
        Next
 
        Exit Sub
    End If
 
    For a = LBound(myBackup, 1) To UBound(myBackup, 1)
        'filtrujemy dla wszystkich widocznych kolumn
        tmp = Split(myList.ColumnWidths, ";")
 
        'nieokreslone rozmiary kolumn, czyli wszystkie widoczne:
        If UBound(tmp) <> -1 Then 
            x = myList.ColumnCount - 1
        Else
            x = 0
        End If
 
        For b = 0 To x
            isVisible = False
            If UBound(tmp) < b Then
                isVisible = True
            ElseIf tmp(b) <> "0 pt" Then 'nie mozna wywolac tmp(b) jesli UBound(tmp) < b
                isVisible = True
            End If
 
            If isVisible = True And _
            LCase(myBackup(a, b)) Like "*" & LCase(myTextBox.Text) & "*" Then
                myList.AddItem (myBackup(a, 0))
                For c = LBound(myBackup, 2) To UBound(myBackup, 2)
                    If Not IsNull(myBackup(a, c)) Then
                        myList.List(myList.ListCount - 1, c) = myBackup(a, c)
                    End If
                Next
            End If
        Next
    Next
 
End Sub

Powodzenia!

2 komentarzy

Rafal  dnia grudzień 25th, 2010

Witam,

Po całkiem długich poszukiwaniach trafiłem na ten temat i wygląda na to, że w 100% rozwiąże mój problem. Mam jedynie problem ze zrozumieniem w jaki sposób jest tu zdefiniowana lista, nie ma żadnej nazwy skoroszytu. Czy mógłbyś wyjaśnij odrobinę w jaki sposób jest to zrobione. W VBA narazie raczkuje.

Pozdrawiam ( i życzę Wesołych Świąt przy okazji :))
Rafal

WRonX  dnia marzec 1st, 2011

@Rafal:
No, jak człowiek trochę zaśpi, to i parę miesięcy na bloga nie zagląda, najmocniej przepraszam.
Co do Twojego pytania, nie ma nazwy skoroszytu, bo w tym konkretnym przypadku operujemy na liście w postaci ComboBox utworzonej w okienku (formie?), tedy nie ma możliwości odwołania się do skoroszytu/arkusza etc.

Skomentuj: