Jednym z najbardziej popularnych tematów w VBA, jest utworzenie raportów dla każdej unikatowej wartości z kolumny. Chodzi tu o przefiltrowanie tabeli według jednego kryterium i zapisanie wyniku w formie osobnego zestawienia. Takim raportem może być oddzielny arkusz lub dedykowany plik Excela. W tym artykule opiszę jak stworzyć taki mechanizm od A do Z.
Tabela z listą transakcji
Naszą tabelą bazową będzie rejestr zakupów w sklepie komputerowym. Dane zostały wygenerowane losowo – nie zwracaj proszę uwagi na ich poprawność. Interesuje nas tylko kolumna H. Przechowuje ona informacje dotyczące producenta sprzętu.
Raporty dla producentów
Naszym celem jest napisanie makra, które utworzy osobny raport XLSX dla każdego producenta z listą podległych mu transakcji. Coś jak na tym screenie poniżej.
A tak wygląda już efekt docelowy. Prawda, że robi wrażenie? Trzy sekundy i gotowe!
Analiza makra
Jak napisać takie makro? Poniżej opiszę to w szczegółach.
Unikatowa lista producentów
Pierwszą rzeczą, którą musimy zrobić jest pobranie unikatowej listy producentów z kolumny H.
W tym celu najlepiej napisać własną funkcję VBA. Jej parametrem może być zakres komórek z duplikatami. W wyniku funkcja powinna zwrócić tablicę lub kolekcję unikatowych wartości. Może ona wyglądać np. w ten sposób:
|
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 |
Public Function UnikatowiProducenci(rngZakres As Range) As Collection Dim colTemp As Collection ' Będziemy przypisywać wynik do funkcji Dim rngKomorka As Range ' Pojedyncza komórka z kolumny PRODUCENT Dim sProducent As String ' Nazwa producenta Set colTemp = New Collection ' Inicjuj nową kolekcję ' Sprawdź każdą komórkę z kolumny PRODUCENT, pobierz nazwę producenta ' i dodaj ją do kolekcji, jeżeli jej tam nie ma. W ten sposób powstanie ' unikatowa lista producentów - dla każdego utworzymy osobny plik. On Error Resume Next ' Ignoruj wszystkie błędy. Będą się one pojawiać ' gdy spróbujemy dodać do kolekcji element, który już tam jest. For Each rngKomorka In rngZakres.Cells ' Kolejna komórka do sprawdzenia sProducent = rngKomorka.Value ' Pobierz nazwę producenta do zmiennej colTemp.Add Item:=sProducent, _ Key:=sProducent ' Dodaj do kolekcji nazwę producenta Next rngKomorka ' Przejdź do następnej komórki ' Przypisz do wyniku funkcji wartość colTemp Set UnikatowiProducenci = colTemp End Function |
Ostatni niepusty wiersz
Wiemy, że dane dotyczące producentów zaczynają się w komórce H2. Nie wiemy jednak, gdzie się kończą… W tym celu musimy sprawdzić, gdzie znajduje się ostatni niepusty wiersz.
Standardowo do tego celu wykorzystuję osobną procedurę opartą o funkcję arkuszową PODAJ.POZYCJĘ. W tym przykładzie, dla uproszczenia, użyłem właściwości CurrentRegion obiektu Range, która zwróciła mi liczbę 101.
Wiedząc, że nazwy producentów znajdują się w zakresie H2:H101 przekazuję ten obszar do funkcji UnikatowiProducenci.
|
1 2 3 4 5 |
' Pobierz do kolekcji unikatowe nazwy producentów Set colProducenci = UnikatowiProducenci( _ wksTransakcje.Range("H2:H" & lTransakcjeOst)) |
W wyniku otrzymuję kolekcję unikatowych nazw producentów. Przypisuję ją do zmiennej colProducenci.
Wynik działania funkcji zawsze warto przypisać do zmiennej. Musimy tylko pamiętać o zgodności typów tj. jeżeli funkcja zwraca w wyniku tekst (String) to zmienna również powinna zostać zadeklarowana jako String.
Katalog na raporty
Aby zachować porządek, raporty XLSX dobrze zapisać w konkretnym katalogu. Możemy go nazwać Producenci i utworzyć w folderze, w którym jest plik główny.
Przed zapisem raportów, musimy się upewnić, że katalog Producenci znajduje się na dysku. Jeśli go tam nie ma – musimy go utworzyć makrem.
Takie sprawdzenie jest konieczne, ponieważ w przeciwnym razie makro zwróci błąd. Będziemy próbowali zapisywać raporty w katalogu, który nie istnieje… Jako programiści VBA musimy być maksymalnie przezorni.
|
1 2 3 4 5 |
Public Function bCzyKatalogIstnieje(ByVal sPelnaSciezka As String) As Boolean bCzyKatalogIstnieje = CBool(Len(Dir(sPelnaSciezka, vbDirectory)) <> 0) End Function |
Filtrowanie danych w pętli
Najważniejszą częścią naszego makra jest sprawdzenie w pętli każdego elementu kolekcji. Możemy to zrobić za pomocą instrukcji For Each.
|
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 |
' Generuj raport XLSX dla kazdego producenta For Each vElement In colProducenci ' Kolejny element kolekcji do sprawdzenia ' Pobierz nazwę producenta do zmiennej typu STRING sProducent = vElement ' Wpisz nazwę producenta do kryterium filtra wksTransakcje.Range("K2").Value = sProducent Set wkbRaport = Workbooks.Add ' Dodaj nowy plik XLSX Set wksRaport = wkbRaport.Worksheets(1) ' Pierwsza zakładka w pliku XLSX ' Przefiltruj dane filtrem zaawansowanym rngTransakcje.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=wksTransakcje.Range("K1:K2"), _ CopyToRange:=wksRaport.Range("A1"), _ Unique:=False ' Wyrównaj szerokość komórek wksRaport.UsedRange.EntireColumn.AutoFit ' Zapisz plik z nazwą producenta i zamknij go. Wcześniej jednak ignoruj ' ewentualne komunikaty z informacją o nadpisaniu pliku. Application.DisplayAlerts = False ' Wyłącz komunikaty wkbRaport.SaveAs Filename:=sKatalogProducenci & "\" & sProducent & ".xlsx", _ FileFormat:=XlFileFormat.xlWorkbookDefault Application.DisplayAlerts = False ' Włącz komunikaty ' Zamknij plik, zmiany już mamy zapisane wkbRaport.Close SaveChanges:=False Next vElement |
Jak działa ten fragment kodu?
- Pobieramy nazwę producenta do zmiennej sProducent.
- Wpisujemy tą informację do komórki K2. W komórce K1 znajduje się nagłówek. Zakres K1:K2 to kryterium dla filtra zaawansowanego. Będziemy korzystać właśnie z tego wbudowanego narzędzia Excela. Pozwala ono w szybki i łatwy sposób wyfiltrować potrzebne dane i przenieść je poza tabelę źródłową.
- Tworzymy nowy plik Excela. To właśnie tam trafią wyfiltrowane dane.
- Filtrujemy tabelę. Wiersze z transakcjami producenta trafiają do nowego pliku.
- Wyrównujemy szerokość kolumn. Wszystkie informacje warto pokazać w całości.
- Wyłączamy ostrzeżenia. Jest to zabezpieczenie na wypadek, gdyby w tej lokalizacji znajdował się już plik z taką nazwą. Wyłączenie monitów spowoduje nadpisanie pliku. I o takie rozwiązanie nam chodzi.
- Zapisujemy plik z rozszerzeniem XLSX. Nazwą pliku jest nazwa producenta.
- Włączamy ostrzeżenia. Wracamy do ustawień domyślnych.
- Zamykamy raport XLSX. Musimy to zrobić. Nie chcemy przecież, aby efektem działania makra, było kilkanaście otwartych plików.
- Powtarzamy sekwencję. Makro przechodzi do następnego producenta (elementu kolekcji) i powtarza wszystkie czynności, które opisałem powyżej.
Plik XLSM
Pobierz plik i przeanalizuj kod metodą krokową (F8).
