'********************************************************************************************************** ' Nazwa: polaczTablice ' Autor: mielk | 2013-04-26 ' ' Opis: Funkcja łączy podane tablice w jedną zbiorczą tablicę. ' Funkcja operuje tylko na tablicach jedno- oraz dwuwymiarowych i może przyjąć ' maksymalnie do 30 tablic. ' ' ' Argumenty: ' tablice Tablice, które mają zostać scalone w jedną tablicę. ' * Funkcja maksymalnie może ze sobą połączyć 30 tablic. ' * Funkcja obsługuje tylko tablice 1D i 2D. ' * Wszystkie elementy nie-tablicowe są ignorowane. ' * Wszystkie tablice podane jako parametry wejściowe, muszą mieć taką samą liczbę ' wymiarów - niemożliwe jest łączenie tablic jedno- z dwuwymiarowymi. ' * Elementy z tablic źródłowych są dodawane do tablicy wynikowej w takiej ' kolejności, w jakiej tablice zostały podane przy wywoływaniu funkcji. ' ' Zwraca: ' Variant() Tablica będąca połączeniem wszystkich tablic wejściowych podanych do tej funkcji. ' Tablica wynikowa nieco się różni w zależności od tego czy łączone są tablice jedno- ' czy dwuwymiarowe. ' ----------------------------------------------------------------------------------- ' [Tablice 1D] ' Dla tablic jednowymiarowych wynikiem będzie również tablica jednowymiarowa, ' posiadająca tyle elementów, ile wynosi łączna liczba elementów tablic wejściowych ' przekazanych do funkcji. ' ' Przykład: ' --------------- ' 'Jeżeli do funkcji zostaną przekazane następujące tablice (wymiary podane w ' nawiasach za nazwą tablicy): ' - tablica(1 To 3) - czyli tablica zawierająca 3 elementy, ' - tablica2(10 To 15) - czyli tablica zawierająca 6 elementów, ' - tablica3(-2 To 2) - czyli tablica zawierająca 5 elementów, ' to wynikiem będzie jednowymiarowa tablica zawierająca 14 elementów (suma wszystkich ' elementów z przekazanych tablic) - polaczTablice(1 To 14). ' ' ----------------------------------------------------------------------------------- ' [2D tablice] ' W przypadku łączenia tablic dwuwymiarowych, przekazywane do funkcji tablice mogą ' różnić się między sobą liczbą kolumn. ' Tablica wynikowa będzie posiadała tyle kolumn, ile tablica źródłowa z największą ' liczbą kolumn oraz tyle wierszy, ile wynosi suma wierszy we wszystkich tablicach ' wejściowych. ' ' ' UWAGA! Za kolumny uznawany jest pierwszy wymiar tablicy dwuwymiarowej, ' natomiast za wiersze drugi wymiar. Jest to wprawdzie sprzeczne z zasadą ' obowiązującą w odwoływaniu się do arkusza Excela, gdzie pierwszą współrzedną ' jest numer wiersza, a drugą numer kolumny (np. Cells(2,1) jest komórką w drugim ' wierszu i pierwszej kolumnie, a nie na odwrót), ale zgodne z zasadami ' obowiązującymi dla printowania do arkusza i dynamicznego rozszerzania tablic VBA ' (na ten temat znajdziesz więcej w naszym kursie, w lekcji poświęconej ' tablicom VBA). ' ' Przykład: ' --------------- ' Załóżmy, że do funkcji zostały przekazane następujące tablice (wymiary ' podane w nawiasach): ' - tablica1(1 To 10, 1 To 2) - tablica zawierająca 10 kolumn i 2 wiersze ' - tablica2(3 To 5, 1 To 10) - tablica zawierająca 3 kolumny i 10 wierszy ' - tablica3(-2 To 6, 4 To 10) - tablica zawierająca 8 kolumn i 7 wierszy ' Wynikiem będzie tablica zawierająca 10 kolumn i 19 wierszy. ' ' Liczba kolumn tablicy wynikowej (10) wynika z tego, że posiada ona zawsze tyle ' kolumn, ile tablica źródłowa z największą liczbą kolumn. W omawianym przykładzie ' tablice wejściowe posiadają kolejno 10, 3 i 8 kolumn (jak napisano wcześniej, ' jako kolumny traktowany jest pierwszy wymiar) - maksymalną wartością jest 10, więc ' tyle też kolumn będzie posiadała tablica wynikowa. ' Liczba wierszy tablicy wynikowej (19) wynika stąd, że posiada ona zawsze tyle ' wierszy, ile łączna liczba wierszy we wszystkich przekazanych tablicach. ' W omawianym przykładzie tablice wynikowe posiadają kolejno 2, 10 i 7 wierszy, co ' łącznie daje 19 wierszy w tablicy wynikowej. ' ' UWAGA! Aby prawidłowo połączyć tablice, do których przypisano bezpośrednio ' zakresy arkuszy Excela [Range(Cells(..., ...), Cells(..., ...))], przed ' przekazaniem do funkcji trzeba je najpierw transponować. Można w tym celu ' wykorzystać arkuszową funkcję Transpose: ' polaczTablice(Application.WorksheetFunction.Transpose(a1), ' Application.WorksheetFunction.Transpose(a2)) ' jednak znacznie bezpieczeniej jest użyć prezentowanej na naszej stronie funkcji ' transponujTablice, która jest uodporniona na błędy generowane w niektórych ' sytuacjach przez wspomnianą przed momentem funkcję tablicową (np. w sytuacji, kiedy ' transponowana tablica ma ponad 32677 wierszy): ' polaczTablice(transponeArray(tablica1), transponeArray(tablica2)). ' ' ' Tablica wynikowa domyślnie jest indeksowana od 1. Aby zmienić to ustawienie należy ' przypisać żądaną wartość dolnego indeksu do stałej PIERWSZY_INDEKS. ' ' ' ' Wyjątki: ' RoznaLiczbaWymiarow Wywoływany w sytuacji, gdy tablice wejściowe różnią się pomiędzy sobą ' liczbą wymiarów, np. część tablic jest jednowymiarowa a część ' dwuwymiarowa. ' ' NiedozwolonaLiczbaWymiarow Wywoływana, kiedy tablice podane do funkcji mają więcej niż ' dwa wymiary. ' ' ' --- Zmiany ---------------------------------------------------------------------------------------------- ' 2013-04-26 mielk Utworzenie funkcji. '********************************************************************************************************** Public Function polaczTablice(ParamArray tablice() As Variant) As Variant() Const NAZWA_METODY As String = "polaczTablice" Const PIERWSZY_INDEKS As Byte = 1 '------------------------------------------------------------------------------------------------------ Dim tablica As Variant Dim prawidloweTablice() As Variant Dim licznikTablic As Byte Dim maksymalnyWymiar As Byte Dim wymiarTablicy As Byte '------------------------------------------------------------------------------------------------------ 'Funkcja sprawdza z osobna każdy z argumentów przekazanych do funkcji. ------------------------------| 'Wszystkie argumenty nie będące tablicami lub będące pustymi tablicami są ignorowane '| 'Oprócz tego, pętla sprawdza też czy wszystkie tablice mają identyczną liczbę wymiarów. '| For Each tablica In tablice '| '| 'Sprawdź czy element aktualnie rozpatrywany w pętli jest zdefiniowaną tablicą. --------------| '| 'Jeżeli nie, zostanie on zignorowany. '| '| If czyZdefiniowanaTablica(tablica) Then '| '| wymiarTablicy = liczWymiary(tablica) '| '| '| '| 'Jeżeli zmienna bMaxWymiar jest większa niż 0, oznacza to, że sprawdzana ------------| '| '| 'tablica nie jest pierwszą tablicą w zbiorze argumentów i liczba wymiarów '| '| '| 'została już wcześniej ustalona. '| '| '| 'Jeżeli liczba wymiarów aktualnie rozpatrywanej tablicy jest inna niż ta ustalona '| '| '| 'wcześniej wartość, a więc przekazane tablice mają różne liczby wymiarów i funkcja '| '| '| 'przeskakuj do obsługi wyjątku RoznaLiczbaWymiarow. '| '| '| If maksymalnyWymiar > 0 And wymiarTablicy <> maksymalnyWymiar Then '| '| '| '| '| '| GoTo RoznaLiczbaWymiarow '| '| '| '| '| '| Else '| '| '| '| '| '| 'Jeżeli analizowana tablica jest pierwszą tablicą w zbiorze (czyli '| '| '| 'maksymalnyWymiar = 0), liczba jej wymiarów jest traktowana jako bazowa '| '| '| 'liczba wymiarów, z którą będą porównywane liczby wymiarów pozostałych tablic. '| '| '| If maksymalnyWymiar = 0 Then maksymalnyWymiar = wymiarTablicy '| '| '| '| '| '| licznikTablic = licznikTablic + 1 '| '| '| ReDim Preserve prawidloweTablice(1 To licznikTablic) '| '| '| prawidloweTablice(licznikTablic) = tablica '| '| '| '| '| '| End If '| '| '| '------------------------------------------------------------------------------------| '| '| '| '| End If '| '| '--------------------------------------------------------------------------------------------| '| '| Next tablica '| '----------------------------------------------------------------------------------------------------| 'Ze względów wydajnościowych, łączenie tablic jedno- i dwuwymiarowych zostało rodzielone na ---------| 'dwie oddzielne podfunkcje. Odpowiednia podfunkcja wywoływana jest na podstawie ustalonej '| 'wcześniej liczby wymiarów łączonych tablic. '| Select Case maksymalnyWymiar '| Case 1: polaczTablice = polaczTablice1D(PIERWSZY_INDEKS, prawidloweTablice) '| Case 2: polaczTablice = polaczTablice2D(PIERWSZY_INDEKS, prawidloweTablice) '| Case Else: GoTo NiedozwolonaLiczbaWymiarow '| End Select '| '---------------------------------------------------------------------------------------------------| '========================================================================================================== PunktWyjscia: Exit Function '---------------------------------------------------------------------------------------------------------- RoznaLiczbaWymiarow: 'Obsługa błędów dla sytuacji, kiedy podane tablice wejściow różnią się pomiędzy sobą liczbą wymiarów. GoTo PunktWyjscia NiedozwolonaLiczbaWymiarow: 'Obsługa błędów dla przypadku, kiedy podane tablice wejściowe mają więcej niż dwa wymiary. GoTo PunktWyjscia End Function '********************************************************************************************************** ' Nazwa: polaczTablice1D ' Autor: mielk | 2013-04-26 ' ' Opis: Podfunkcja przeznaczona do łączenia tablic jednowymiarowych. ' ' Argumenty: ' pierwszyIndeks Określa od jakiego początkowego numeru indeksowana będzie tablica wynikowa. ' tablice() Tablice jednowymiarowe, które mają zostać połączone w jedną tablicę. Walidacja ' przekazanych tablic pod kątem liczby wymiarów jest dokonywana w procedurze ' wywołującej (polaczTablice). ' ' Zwraca: ' Variant() Tablica będąca kombinacją wszystkich podanych tablic jednowymiarowych. ' ' ' --- Zmiany ---------------------------------------------------------------------------------------------- ' 2013-04-26 mielk Utworzenie funkcji. '********************************************************************************************************** Private Function polaczTablice1D(pierwszyIndeks As Byte, tablice() As Variant) As Variant() Const NAZWA_METODY As String = "polaczTablice1D" '------------------------------------------------------------------------------------------------------ Dim tablica As Variant Dim polaczone() As Variant Dim lngWiersze As Long Dim lngWierszWyniku As Long Dim lngWierszZrodlowy As Long '------------------------------------------------------------------------------------------------------ 'Pętla zliczająca łączną liczbę elementów we wszystkich tablicach przeznaczonych do złączenia. ------| For Each tablica In tablice '| lngWiersze = lngWiersze + UBound(tablica, 1) - LBound(tablica, 1) + 1 '| Next tablica '| '----------------------------------------------------------------------------------------------------| 'Tworzy tymczasową tablicę jednowymiarową posiadającą dokładnie tyle elementów ile wynosi łączna 'liczba elementów wszystkich tablic przekazanych do funkcji i indeksowaną od liczby wskazanej 'w argumencie wejściowym [pierwszyIndeks]. ReDim polaczone(pierwszyIndeks To lngWiersze + pierwszyIndeks - 1) 'Pętla wykonywana dla każdej tablicy źródłowej, wrzucająca wszystkie jej elementy -------------------| 'do tablicy wynikowej. Iterator [lWierszZrodlowy] jest zerowany przy każdym powtórzeniu pętli, '| 'gwarantując że dla każdej tablicy wrzucane są wszystkie jej elementy. '| 'Iterator [lWierszWynikowy] przechowuje natomiast swoją wartość pomiędzy poszczególnymi '| 'powtórzeniami pętli, dzięki czemu dodawane elementy nie nadpisują elementów dodanych wcześniej. '| lngWierszWyniku = pierwszyIndeks '| For Each tablica In tablice '| '| '--------------------------------------------------------------------------------------------| '| For lngWierszZrodlowy = LBound(tablica, 1) To UBound(tablica, 1) '| '| polaczone(lngWierszWyniku) = tablica(lngWierszZrodlowy) '| '| lngWierszWyniku = lngWierszWyniku + 1 '| '| Next lngWierszZrodlowy '| '| '--------------------------------------------------------------------------------------------| '| '| Next tablica '| '----------------------------------------------------------------------------------------------------| polaczTablice1D = polaczone End Function '********************************************************************************************************** ' Nazwa: polaczTablice2D ' Autor: mielk | 2013-04-26 ' ' Opis: Podfunkcja przeznaczone do łączenia tablic dwuwymiarowych. ' ' Argumenty: ' pierwszyIndeks Określa od jakiego początkowego numeru indeksowana będzie tablica wynikowa. ' tablice() 2D tablice to be joined. ' ' Zwraca: ' Variant() Tablice dwuwymiarowe, które mają zostać połączone w jedną tablicę. Walidacja ' przekazanych tablic pod kątem liczby wymiarów jest dokonywana w procedurze ' wywołującej (polaczTablice). ' ' ' --- Zmiany ---------------------------------------------------------------------------------------------- ' 2013-04-26 mielk Utworzenie funkcji. '********************************************************************************************************** Private Function polaczTablice2D(pierwszyIndeks As Byte, tablice() As Variant) As Variant() Const NAZWA_METODY As String = "polaczTablice2D" '------------------------------------------------------------------------------------------------------ Dim tablica As Variant Dim polaczone() As Variant Dim licznikKolumn As Long Dim lngMaksymalnaKolumna As Long Dim lngWiersze As Long Dim lngWierszWyniku As Long Dim lngWierszZrodlowy As Long Dim lngKolumnaWyniku As Long Dim lngKolumnaZrodlowa As Long '------------------------------------------------------------------------------------------------------ 'Pętla przechodząca przez wszystkie przekazane do funkcji tablice dwuwymiarowe, której celem --------| 'jest zliczenie łącznej liczby wierszy oraz wyznaczenie maksymalnej liczby kolumn we wszystkich '| 'tych tablicach. '| For Each tablica In tablice '| licznikKolumn = UBound(tablica, 1) - LBound(tablica, 1) + 1 '| If licznikKolumn > lngMaksymalnaKolumna Then lngMaksymalnaKolumna = licznikKolumn '| lngWiersze = lngWiersze + UBound(tablica, 2) - LBound(tablica, 2) + 1 '| Next tablica '| '----------------------------------------------------------------------------------------------------| 'Tworzy tymczasową tablicę dwuwymiarową indeksowaną od liczby wskazanej w argumencie wejściowym -----| '[pierwszyIndeks], posiadającą dokładnie tyle wierszy, ile wynosi łączna liczba wierszy wszystkich '| 'tablic przekazanych do funkcji oraz tyle kolumn, ile tablica źródłowa z największą liczbą kolumn. '| 'and columns worked out before. '| ReDim Preserve polaczone(pierwszyIndeks To lngMaksymalnaKolumna + pierwszyIndeks - 1, _ pierwszyIndeks To lngWiersze + pierwszyIndeks - 1) '| '----------------------------------------------------------------------------------------------------| 'Pętla wykonywana dla każdej tablicy źródłowej, wrzucająca wszystkie jej elementy do ----------------| 'tablicy wynikowej. '| lngWierszWyniku = pierwszyIndeks '| For Each tablica In tablice '| '| '--------------------------------------------------------------------------------------------| '| For lngWierszZrodlowy = LBound(tablica, 2) To UBound(tablica, 2) '| '| lngKolumnaWyniku = pierwszyIndeks '| '| '| '| '------------------------------------------------------------------------------------| '| '| For lngKolumnaZrodlowa = LBound(tablica, 1) To UBound(tablica, 1) '| '| '| polaczone(lngKolumnaWyniku, lngWierszWyniku) = tablica(lngKolumnaZrodlowa, _ lngWierszZrodlowy) '| '| '| lngKolumnaWyniku = lngKolumnaWyniku + 1 '| '| '| Next lngKolumnaZrodlowa '| '| '| '------------------------------------------------------------------------------------| '| '| '| '| lngWierszWyniku = lngWierszWyniku + 1 '| '| '| '| Next lngWierszZrodlowy '| '| '--------------------------------------------------------------------------------------------| '| '| Next tablica '| '----------------------------------------------------------------------------------------------------| polaczTablice2D = polaczone End Function '********************************************************************************************************** ' Nazwa: czyZdefiniowanaTablica ' Autor: mielk | 2012-03-27 ' ' Opis: Funkcja sprawdzająca czy podany parametr jest niepustą tablicą. ' ' Argumenty: ' arr Sprawdzany parametr. ' ' Zwraca: ' Boolean True - jeżeli parametr [arr] jest tablicą, której wymiary zostały już zadeklarowane. ' False - jeżeli parametr [arr] nie jest tablicą lub jest tablicą dynamiczną, której wymiary ' nie zostały jeszcze zdefiniowane. ' ' --- Zmiany ---------------------------------------------------------------------------------------------- ' 2012-03-27 mielk Stworzenie funkcji. '********************************************************************************************************** Public Function czyZdefiniowanaTablica(arr As Variant) As Boolean Const NAZWA_METODY As String = "czyZdefiniowanaTablica" '------------------------------------------------------------------------------------------------------ Dim gornaGranica As Long Dim dolnaGranica As Long '------------------------------------------------------------------------------------------------------ 'Funkcja próbuje przypisać do zmiennych dolnaGranica i gornaGranica dolną i górną granicę podanego 'parametru. 'Jeżeli podany argument nie jest tablicą lub jest dynamiczną tablicą bez zadeklarowanych jeszcze 'wymiarów, wygenerowany zostanie błąd, który spowoduje przeniesienie kodu do labelu NieTablica, 'co z kolei sprawi, że cała funkcja zwróci wartość False. On Error GoTo NieTablica gornaGranica = UBound(arr, 1) dolnaGranica = LBound(arr, 1) 'W niektórych przypadkach pobranie właściwości LBound i UBound będzie możliwe nawet jeśli podany 'argument jest pustą tablicą (np. dla tablic podanych jako parametr typu ParamArray). W takiej 'sytuacji wartość UBound będzie jednak mniejsza niż wartość LBound, dlatego poniższe sprawdzenie 'pozwoli rozpoznać takie tablice i zwrócić dla nich wartość False. czyZdefiniowanaTablica = (gornaGranica >= dolnaGranica) '========================================================================================================== PunktWyjscia: Exit Function '---------------------------------------------------------------------------------------------------------- NieTablica: GoTo PunktWyjscia End Function '********************************************************************************************************** ' Nazwa: liczWymiary ' Autor: mielk | 2012-03-03 ' ' Opis: Funkcja zwraca liczbę wymiarów podanej tablicy VBA. ' ' Argumenty: ' tablica Tablica, której liczba wymiarów ma zostać zwrócona. ' ' Zwraca: ' Integer Liczba wymiarów podanej tablicy VBA. ' Jeżeli podana wartość nie jest tablicą lub jest zadeklarowana jako tablica ' dynamiczna, ale nie przypisano jeszcze do niej liczby wymiarów, zwracana ' jest wartość 0. ' ' ' --- Zmiany ---------------------------------------------------------------------------------------------- ' 2012-03-03 mielk Utworzenie funkcji ' 2014-06-15 mielk Zwracany typ zmieniony na Integer, żeby umożliwić zwracanie wartości -1, ' jeżeli podany parametr nie jest w ogóle tablicą. '********************************************************************************************************** Public Function liczWymiary(tablica As Variant) As Integer Const NAZWA_METODY As String = "liczWymiary" '------------------------------------------------------------------------------------------------------ Dim granica As Long '------------------------------------------------------------------------------------------------------ If VBA.IsArray(tablica) Then On Error GoTo NieistniejacyWymiar Do granica = UBound(tablica, liczWymiary + 1) liczWymiary = liczWymiary + 1 Loop Else liczWymiary = -1 End If '---------------------------------------------------------------------------------------------------------- NieistniejacyWymiar: End Function