Użytkownicy Excela często używają sprawdzania poprawności do tworzenia list kaskadowych. Pierwsza lista zwykle przechowuje unikatowe wpisy np. marki aut. Po wybraniu konkretnej wartości (marki), do drugiej listy ładowane są przypisane do niej elementy (np. modele aut tej marki). Taka lista zależna jest dość łatwa do zrobienia także w VBA.
Podział drużyn w NBA
Jako, że prywatnie jestem miłośnikiem sportu, zadanie to wykonam w oparciu o NBA.
NBA jest zawodową ligą koszykarską i gra w niej 30 drużyn. Są one podzielone na dwie równomierne konferencje – wschodnią i zachodnią. Dodatkowo, każda konferencja jest podzielona na trzy dywizje. W każdej dywizji znajduje się pięć zespołów.
Proste, prawda? Możemy to zobrazować w następujący sposób?
Jak to się ma do naszej listy kaskadowej? Dokładnie tak jak myślisz! 🙂
Najpierw wybierzemy konferencję, potem dywizję, a na końcu drużynę. Jej logo wyświetlimy w kontrolce Image.
Zaczynamy od końca
Zacznę nieco przewrotnie – pokazując efekt końcowy. Potem omówię warunki i wkleję kod.
Najważniejsze pytanie
Ideę zadania znamy. Po wybraniu konferencji musi się pojawić zależna lista dywizji, a po wybraniu dywizji – lista kaskadowa drużyn.
Przed rozpoczęciem prac, musimy odpowiedzieć sobie na jedno za……iście ważne pytanie 🙂
Co ma się konkretnie dziać przy starcie formularza
i podczas kliknięcia, w któryś w przycisków?
Ustawienia startowe
Przy uruchomieniu formularza wyzwalane jest zdarzenie inicjalizacji. Jest to więc idealny moment na załadowanie ustawień startowych. Do kontrolek ListBox i ComboBox wgrywane są listy źródłowe z danymi. Zaznaczane są także niektóre pola wyboru lub przycisk opcji.
W naszym przypadku nie musimy tego robić, ponieważ mamy tylko dwie konferencje – wschodnią i zachodnią. I taka sytuacja na pewno się nie zmieni w najbliższym czasie. No chyba, że w NBA dojdzie do prawdziwej rewolucji i reorganizacji rozgrywek. Ale na to obecnie się nie zanosi.
Mając dwie konferencje wystarczy skorzystać z dwóch przycisków opcji.
Nie ma sensu tworzyć pola listy czy pola kombi w przypadku, gdy mamy tylko dwie opcje do wyboru.
Co istotne – nie musimy na starcie ładować listy dywizji, ani listy klubów. Te informacje są podrzędne względem konferencji i zostaną załadowane zależnie od tego, czy wybierzemy przycisk Wschodnia czy Zachodnia.
Wybór konferencji
Wybranie konferencji powinno implikować kilka rzeczy:
- Zapisanie wybranej konferencji do zmiennej poziomu modułu. Taką informację musimy gdzieś zachować.
- Uruchomienie funkcji, która na podstawie argumentu (konferencja), zwróci w wyniku tablicę podległych jej dywizji.
- Załadowanie listy dywizji do pola lstDywizja. W ten sposób powstanie lista zależna.
- Wyzerowanie tablicy z listą klubów. Nie mamy jeszcze wybranej dywizji, tylko samą konferencję.
- Usunięcie logo klubu. Jeśli na formularzu pojawia się logo, którejś z drużyn to musimy je usunąć. W takiej sytuacji możemy zostawić kontrolkę Image bez zdjęcia, ale lepszym pomysłem jest wstawienie logo całej ligi NBA.
Wybór dywizji
Jeżeli wybraliśmy już konferencję to wyświetla się lista trzech dywizji w jej obrębie.
Zastanówmy się, co powinno się stać jeśli wybierzemy np. dywizję centralną...
- Zapisanie wybranej dywizji do zmiennej poziomu modułu.Taką informację musimy gdzieś zapisać.
- Uruchomienie funkcji, która na podstawie argumentu (dywizja), zwróci w wyniku tablicę podległych jej drużyn.
- Załadowanie listy drużyn do pola lstKluby. W ten sposób powstanie lista zależna.
- Usunięcie logo klubu. Jeśli na formularzu pojawia się logo, którejś z drużyn to musimy je usunąć.
Czyli tutaj praktycznie powtarzamy to, co robiliśmy w punkcie dotyczącym wyboru konferencji.
Pomijamy jedynie punkt związany z wyzerowaniem listy klubów, ponieważ wybierając konkretną dywizję, ta lista od razu nam się wyświetli.
Wybór klubu
Jeżeli wybraliśmy już dywizję (np. centralną) to wyświetli nam się lista pięciu drużyn w jej obrębie. Zastanówmy się, co powinno się stać jeśli wybierzemy np. Chicago Bulls.
- Zapisanie wybranej dużyny do zmiennej poziomu modułu.Taką informację musimy gdzieś zapisać.
- Musimy załadować logo tego klubu do kontrolki Image.
Kod w module formularza
Poniżej wklejam cały kod, który znajduje się w module formularza. Pamiętajmy, że formularz jest przykładem klasy, zatem musimy go traktować jak obiekt, do którego możemy się odwołać poprzez właściwości i metody.
|
1 2 3 4 5 6 7 8 9 10 11 |
Private Const msMODUL As String = "UNBA" Option Explicit Private m_sKonferencja As String '// Wybrana konferencja Private m_sDywizja As String '// Wybrana dywizja Private m_sKlub As String '// Wybrana drużyna Private m_avListaDywizji As Variant '// Lista dywizji dla konferencji Private m_avListaKlubow As Variant '// Lista klubów dla dywizji Dim m_bOK As Boolean |
|
1 2 3 4 5 |
Private Sub cmdOK_Click() m_bOK = True End Sub |
|
1 2 3 4 5 6 |
Private Sub cmdZamknij_Click() m_bOK = False Me.Hide End Sub |
|
1 2 3 4 5 6 7 8 9 10 |
' Powoduje, że znak [x] zachowuje się tak samo, jak przycisk Anuluj. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then m_bOK = False Me.Hide Cancel = True End If End Sub |
|
1 2 3 4 5 6 |
' Zwróć, czy został naciśnięty przycisk OK, czy Anuluj. Public Property Get OK() As Boolean OK = mbOK End Property |
|
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 |
' Obsługa przycisków opcji formularza Private Sub optWschod_Click() 'Zaczytaj do zmiennej prywatnej wybraną konferencję 1 m_sKonferencja = "Wschodnia" 'Zaczytaj listę dywizji w obrębie danej konferencji 2 m_avListaDywizji = ListaDywizji(Konferencja) 'Utwórz listę dywizji jako źródło dla danej konferencji 3 Me.lstDywizja.List = m_avListaDywizji 'Wyczyść listę z klubami 4 Me.lstKluby.Clear 'Załaduj logo NBA 5 ZaladujLogo "" End Sub Private Sub optZachod_Click() 'Zaczytaj do zmiennej prywatnej wybraną konferencję 1 m_sKonferencja = "Zachodnia" 'Zaczytaj listę dywizji w obrębie danej konferencji 2 m_avListaDywizji = ListaDywizji(Konferencja) 'Utwórz listę dywizji jako źródło dla danej konferencji 3 Me.lstDywizja.List = m_avListaDywizji 'Wyczyść listę z klubami 4 Me.lstKluby.Clear 'Załaduj logo NBA 5 ZaladujLogo "" End Sub |
|
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 |
' Obsługa pól listy Private Sub lstDywizja_Click() 'Zaczytaj do zmiennej prywatnej zaznaczoną dywizję 1 m_sDywizja = Me.lstDywizja.Text 'Zaczytaj lisę klubów w obrębie danej dywizji 2 m_avListaKlubow = ListaKlubow(Dywizja) 'Utwórz listę klubów jako źródło dla danej dywizji 3 Me.lstKluby.List = m_avListaKlubow 'Załaduj logo NBA 4 ZaladujLogo "" End Sub Private Sub lstKluby_Click() 'Zaczytaj do zmiennej prywatnej nazwę klubu 1 m_sKlub = Me.lstKluby.Text 'Załaduj logo klubu 2 ZaladujLogo m_sKlub End Sub |
|
1 2 3 4 5 6 |
' Metody i właściwości Public Property Get Konferencja() As String: Konferencja = m_sKonferencja: End Property Public Property Get Dywizja() As String: Dywizja = m_sDywizja: End Property Public Property Get Klub() As String: Klub = m_sKlub: End Property |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
Public Function ListaDywizji(ByVal sKonferencja As String) As Variant Dim lPozycjaKonf As Long Dim lKlubyKonf As Long Dim avListaDywizji As Variant 'Sprawdź pierwsze wystąpienie konferencji 1 lPozycjaKonf = WorksheetFunction.Match(sKonferencja, wksTeams.Range("A:A"), 0) 'Ustal ile klubów mamy z każdej konferencji 2 lKlubyKonf = WorksheetFunction.CountIf(wksTeams.Range("A:A"), sKonferencja) 'Zdefiniuj tablicę dywizji 3 avListaDywizji = vUnikaty(wksTeams.Cells(lPozycjaKonf, "B").Resize(lKlubyKonf, 1)) 'Zaczytaj tą wartość do funkcji 4 ListaDywizji = avListaDywizji End Function |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
Public Function ListaKlubow(ByVal sDywizja As String) As Variant ' Funkcja, która w wyniku zwraca tablicę z nazwami klubów przypisanych do dywizji Dim lPozycjaDiv As Long Dim lKlubyDiv As Long Dim avListaKlubow As Variant 'Sprawdź pierwsze wystąpienie dywizji 1 lPozycjaDiv = WorksheetFunction.Match(sDywizja, wksTeams.Range("B:B"), 0) 'Ustal ile klubów mamy z każdej dywizji 2 lKlubyDiv = WorksheetFunction.CountIf(wksTeams.Range("B:B"), sDywizja) 'Zdefiniuj tablicę dywizji 3 avListaKlubow = vUnikaty(wksTeams.Cells(lPozycjaDiv, "C").Resize(lKlubyDiv, 1)) 'Zaczytaj tą wartość do funkcji 4 ListaKlubow = avListaKlubow End Function |
|
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 |
Private Sub ZaladujLogo(sKlub As String) ' Metoda ładuje logo klubu do kontrolki imgKlub. W przypadku gdy wywołujemy funkcję ' z argumentem vbNullString, wówczas ładowane jest logo NBA Dim sSkrot As String Dim sLokalizacja As String 'Sprawdź, czy przekazano w argumencie nazwę drużyny 1 If Len(sKlub) <> 0 Then 'Skrócona nazwa drużyny 2 sSkrot = Right$(sKlub, Len(sKlub) - InStrRev(sKlub, " ")) 'Sprawdź lokalizację obrazka 3 sLokalizacja = ThisWorkbook.Path & "\LOGO\" & sSkrot & ".gif" 4 Else sLokalizacja = ThisWorkbook.Path & "\LOGO\nba.gif" 5 End If '// If Len(sKlub) <> 0 Then 'Ładuj logo klubu lub logo NBA 6 Me.imgKlub.Picture = LoadPicture(sLokalizacja) End Sub |
Moduł zwykły
W module zwykłym mam funkcję i makro.
Tablica unikatów
Funkcja wyciąga mi w wyniku unikatową listę wpisów, argumentem jest zakres komórek.
|
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 48 |
Public Function vUnikaty(ByRef rngObszar As Range) As Variant ' Funkcja jako argument pobiera zakrres komórek arkusza. ' Zwraca w wyniku jednowymiarową tablicę unikatów. Dim objSlownik As Object 'Dictionary Dim avTablica As Variant Dim r As Long, c As Long Dim vElement As Variant 'Pobierz listę unikatów do tablicy 1 If rngObszar.Count = 1 Then 2 vUnikaty = rngObszar(1) 3 Exit Function 4 Else 5 avTablica = rngObszar 6 End If 'Utwórz obiekt słownika 7 Set objSlownik = CreateObject("Scripting.Dictionary") 'Przejedź w pętli po wszystkich elementach tablicy 8 For r = LBound(avTablica, 1) To UBound(avTablica, 1) 9 For c = LBound(avTablica, 2) To UBound(avTablica, 2) 'Pobierz unikatowy wpis do zmiennej 10 vElement = avTablica(r, c) 'Gdy wpis nie jest pustą komórką lub błędem 'to dodaj go do słownika. 11 If Not IsError(vElement) Then 12 If Len(vElement) <> 0 Then 13 If Not objSlownik.Exists(vElement) Then 14 objSlownik.Add Key:=vElement, Item:=vElement 15 End If '>>> If Not objSlownik.Exists(vElement) Then 16 End If '>>> If Len(vElement) <> 0 Then 17 End If '>>> If Not IsError(vElement) Then 18 Next c '>>> For c = LBound(avTablica, 2) To UBound(avTablica, 2) 19 Next r '>>> For r = LBound(avTablica, 1) To UBound(avTablica, 1) 'Wynikiem działania funkcji jest tablica unikatowych wpisów 20 vUnikaty = objSlownik.Items 21 Set objSlownik = Nothing End Function |
Makro do wyświetlenia formularza
|
1 2 3 4 5 6 7 |
Public Sub WyswietlForme() Dim frmNba As UNBA Set frmNba = New UNBA UNBA.Show vbModal End Sub |
Podsumowanie
Na co powinniśmy zwrócić uwagę, co jest ważne?
- Tabela obowiązkowo musi być posortowana według konferencji i dywizji. Musi być zorganizowana tak jak na pierwszym screenie,
- Zdjęcia nie mogą być zapisane do formatu *.png. Może być *.gif, *.ico lub *.jpg.
- Wszystkie zdjęcia muszą się znajdować w katalogu LOGO. Katalog musi się znajdować w tym samym folderze co plik XLSM.
Pliki
