'**********************************************************************************************************
' Nazwa:                sortujTablice2D
' Autor:                mielk | 2013-03-13
'
' Opis:                 Metoda sortująca podaną tablicę dwuwymiarową według podanej kolumny.
'
' Argumenty:
'   tablica             Tablica przeznaczona do posortowania.
'   kolumna             Indeks kolumny według której ma zostać posortowana podana tablica.
'   czyRosnaco          Argument opcjonalny.
'                       * Określa w jakim porządku - rosnącym czy malejącym - ma zostać posortowana
'                         tablica.
'                       * Jeżeli ten parametr będzie ustawiony na True, tablica zostanie posortowana
'                         rosnąco.
'                       * Jeżeli ten parametr będzie ustawiony na False, tablica zostanie posortowana
'                         malejąco.
'                       * Domyślną wartością tego parametru jest True.
'
'
' Wyjątki:
'   NieTablica                      Wywoływany jeśli podany parametr wejściowy nie jest tablicą.
'   NiedozwolonaLiczbaWymiarow      Wywoływany jeśli tablica podana jako parametr wejściowy ma więcej niż
'                                   dwa wymiary.
'   NiedozwolonyIndeksKolumny       Wywoływany jeżeli indeks kolumny podany jako kryterium sortowania jest
'                                   ujemny lub wyższy niż całkowita liczba kolumn w tej tablicy.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2013-03-13        mielk           Utworzenie funkcji.
'**********************************************************************************************************
Public Sub sortujTablice2D(tablica As Variant, kolumna As Integer, Optional czyRosnaco As Boolean = True)
    Const NAZWA_METODY As String = "sortujTablice2D"
    '------------------------------------------------------------------------------------------------------
    Dim kolejnosc() As Variant
    Dim tempTablica As Variant
    Dim lngWiersze As Long                     'Iterator wierszy
    Dim lngKolumny As Long                      'Iterator kolumn
    Dim lngIndeks As Long
    '------------------------------------------------------------------------------------------------------


    'Sprawdza czy podany paramtetr [tablica] jest tablicą. Jeżeli nie, wykonywanie kodu -----------------|
    'jest przenoszone do labelu NieTablica.                                                             '|
    If Not czyZdefiniowanaTablica(tablica) Then GoTo NieTablica                                         '|
    '----------------------------------------------------------------------------------------------------|


    'Tylko dwuwymiarowe tablice mogą być sortowane za pomocą tej funkcji, dlatego trzeba sprawdzić ------|
    'czy tablica podana jako parametr wejściowy ma dokładnie dwa wymiary. W przeciwnym razie kod        '|
    'przeskakuje do labelu NiedozwolonaLiczbaWymiarow.                                                  '|
    If liczWymiary(tablica) <> 2 Then GoTo NiedozwolonaLiczbaWymiarow                                   '|
    '----------------------------------------------------------------------------------------------------|


    'Sprawdza czy podany indeks kolumny mieści się w zakresie kolumn podanej tablicy wejściowej. --------|
    If UBound(tablica, 1) < kolumna Or LBound(tablica, 1) > kolumna Then GoTo NiedozwolonyIndeksKolumny '|
    '----------------------------------------------------------------------------------------------------|


    'Sprawdza czy podana tablica ma więcej niż jeden element. Dla tablic mających jeden lub żadnego -----|
    'elementu, dalsze operacji nie mają sensu, więc wykonanie kodu jest w takiej sytuacji przenoszone   '|
    'do labelu PojedynczyElement, gdzie faktycznie kończy działanie.                                    '|
    If UBound(tablica, 2) <= 1 Then GoTo PojedynczyElement                                              '|
    '----------------------------------------------------------------------------------------------------|


    'Tworzy tablicę pomocniczą, która będzie użyta jako mapa, gdzie numer wiersza będzie kluczem, -------|
    'do którego przypisana będzie wartość w tablicy na przecięciu tego wiersza i kolumny podanej        '|
    'jako kryterium sortowania.                                                                         '|
    ReDim Preserve kolejnosc(1 To 2, LBound(tablica, 2) To UBound(tablica, 2))                          '|
    For lngWiersze = LBound(tablica, 2) To UBound(tablica, 2)                                           '|
        kolejnosc(1, lngWiersze) = lngWiersze                                                           '|
        kolejnosc(2, lngWiersze) = tablica(kolumna, lngWiersze)                                         '|
    Next lngWiersze                                                                                     '|
    '----------------------------------------------------------------------------------------------------|


    'Tymczasowa tablica jest teraz przekazywana do podprocedury wykonajSortowanie2D, gdzie zostanie  ----|
    'ona posortowana według wartości w drugiej kolumnie.                                                '|
    Call wykonajSortowanie2D(kolejnosc, czyRosnaco)                                                     '|
    '----------------------------------------------------------------------------------------------------|


    'Tworzy nową tablicę tymczasową, w której będzie przechowywała oryginalną zawartość tablicy ---------|
    'źródłowej.                                                                                         '|
    tempTablica = tablica                                                                               '|
                                                                                                        '|
    'Tablica źródłowa jest od początku zapełniana wartościami, w takiej kolejności, jaka została        '|
    'wyliczona w podprocedurze [wykonajSortowanie2D] i która jest przechowywana w tymczasowej           '|
    'tablicy [kolejnosc].                                                                               '|
    For lngWiersze = LBound(tablica, 2) To UBound(tablica, 2)                                           '|
                                                                                                        '|
        lngIndeks = kolejnosc(1, lngWiersze)                                                            '|
                                                                                                        '|
        '--------------------------------------------------------------------------------------------|  '|
        For lngKolumny = LBound(tablica, 1) To UBound(tablica, 1)                                   '|  '|
            If VBA.IsObject(tempTablica(lngKolumny, lngIndeks)) Then                                '|  '|
                Set tablica(lngKolumny, lngWiersze) = tempTablica(lngKolumny, lngIndeks)            '|  '|
            Else                                                                                    '|  '|
                tablica(lngKolumny, lngWiersze) = tempTablica(lngKolumny, lngIndeks)                '|  '|
            End If                                                                                  '|  '|
        Next lngKolumny                                                                             '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    Next lngWiersze                                                                                     '|
    '----------------------------------------------------------------------------------------------------|


'==========================================================================================================
PunktWyjscia:
    Exit Sub


'----------------------------------------------------------------------------------------------------------
NieTablica:
    'Osbługa błędów dla sytuacji, kiedy parametr wejściowy podany do funkcji nie jest tablicą.
    GoTo PunktWyjscia


NiedozwolonaLiczbaWymiarow:
    'Obsługa błędów dla sytuacji, kiedy tablica źródłowa podana jako parametr do funkcji ma więcej lub
    'mniej niż dwa wymiary.
    GoTo PunktWyjscia


NiedozwolonyIndeksKolumny:
    'Obsługa błędów dla sytuacji, kiedy numer kolumny według ktróego ma zostać posortowana tablica jest
    'ujemny lub większy niż łączna liczba kolumn w tej tablicy.
    GoTo PunktWyjscia


PojedynczyElement:
    'Tablica wejściowa ma tylko jeden element, więc jej sortowanie nie ma sensu. Opuść funkcję bez
    'wykonywania żadnej akcji.
    GoTo PunktWyjscia

End Sub




'**********************************************************************************************************
' Nazwa:                wykonajSortowanie2D
' Autor:                mielk | 2013-03-13
'
' Opis:                 Podprocedura używana przez funkcję sortujTablice2D do sortowania podanej mapy
'                       zawierającej wiersze i wartość dla tych wierszy w podanej kolumnie tablicy.
'
'
' Argumenty:
'   tablica             Mapa klucz-wartość, gdzie wiersz jest kluczem, a wartość w tym wierszu i określonej
'                       kolumnie jest użyta jako wartość.
'                       Mapa zostanie posortowana przez tę funkcję w odpowiedniej kolejności i użyta
'                       później do zapełnienia tablicy docelowej.
'   czyRosnaco          Kolejność sortowania.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2013-03-13        mielk           Utworzenie funkcji.
'**********************************************************************************************************
Private Sub wykonajSortowanie2D(tablica() As Variant, czyRosnaco As Boolean)
    Const NAZWA_METODY As String = "wykonajSortowanie2D"
    '------------------------------------------------------------------------------------------------------
    Dim tablicaMniejszych() As Variant          'Tablica zawierająca wartości mniejsze od wartości bazowej.
    Dim tablicaWiekszych() As Variant            'Tablica zawierająca wartości większe od wartości bazowej.
    Dim tablicaDocelowa() As Variant
    Dim mniejszeIndeks As Long
    Dim wiekszeIndeks As Long
    Dim iWiersz As Long
    Dim iMniejsze As Long
    Dim iWieksze As Long
    '------------------------------------------------------------------------------------------------------


    'Sprawdź rozmiary tablicy wejściowej. ---------------------------------------------------------------|
    mniejszeIndeks = LBound(tablica, 2)                                                                 '|
    wiekszeIndeks = UBound(tablica, 2)                                                                  '|
    '----------------------------------------------------------------------------------------------------|


    'Stwórz dwie tablice tymczasowe - jedna przeznaczona na wiersze z wartościami mniejszymi niż --------|
    'wartość bazowa i druga dla wierszy z wartościami wyższymi niż wartość bazowa.                      '|
    'Początkowo nadawany jest im maksymalny możliwy rozmiar (czyli taki jak wartość orryginalnej        '|
    'tablicy), żeby uniknąć czasochłonnej zmiany rozmiarów w trakcie wykonywania sortowania.            '|
    ReDim Preserve tablicaMniejszych(1 To 2, 1 To wiekszeIndeks - mniejszeIndeks)                       '|
    ReDim Preserve tablicaWiekszych(1 To 2, 1 To wiekszeIndeks - mniejszeIndeks)                        '|
    '----------------------------------------------------------------------------------------------------|


    'Sprawdź czy tablica wejściowa ma więcej niż jeden element. Jeżeli ma tylko jeden element, ----------|
    'sortowanie nie ma sensu.                                                                           '|
    If wiekszeIndeks - mniejszeIndeks > 0 Then                                                          '|
                                                                                                        '|
        'Przejedź pętlą po wszystkich elementach oryginalnej tablicy i przydziel je do --------------|  '|
        'odpowiedniej tablicy pomocniczej - [tablicaMniejszych] i [tablicaWiekszych] w zależności   '|  '|
        'od tego czy ich wartość jest wyższa czy niższa od wartości bazowej.                        '|  '|
        'in this array.                                                                             '|  '|
        For iWiersz = mniejszeIndeks + 1 To wiekszeIndeks                                           '|  '|
            If tablica(2, iWiersz) < tablica(2, mniejszeIndeks) Then                                '|  '|
                iMniejsze = iMniejsze + 1                                                           '|  '|
                tablicaMniejszych(1, iMniejsze) = tablica(1, iWiersz)                               '|  '|
                tablicaMniejszych(2, iMniejsze) = tablica(2, iWiersz)                               '|  '|
            Else                                                                                    '|  '|
                iWieksze = iWieksze + 1                                                             '|  '|
                tablicaWiekszych(1, iWieksze) = tablica(1, iWiersz)                                 '|  '|
                tablicaWiekszych(2, iWieksze) = tablica(2, iWiersz)                                 '|  '|
            End If                                                                                  '|  '|
        Next iWiersz                                                                                '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
                                                                                                        '|
        'Zmień rozmiar tablicy [tablicaMniejszych] tak, żeby pozbyć się pustych miejsc. -------------|  '|
        'Następnie sprawdź ile ma elementów - jeżeli ma więcej niż jeden element, wywołaj na        '|  '|
        'niej rekursywnie tę funkcję (wykonajSortowanie2D), żeby posortować jej zawartość.          '|  '|
        If iMniejsze Then                                                                           '|  '|
            ReDim Preserve tablicaMniejszych(1 To 2, 1 To iMniejsze)                                '|  '|
            If iMniejsze > 1 Then Call wykonajSortowanie2D(tablicaMniejszych, czyRosnaco)           '|  '|
        End If                                                                                      '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
        'Identyczną operację jak powyżej przeprowadź na tablicy tymczasowej [tablicaWiekszych]. -----|  '|
        If iWieksze Then                                                                            '|  '|
            ReDim Preserve tablicaWiekszych(1 To 2, 1 To iWieksze)                                  '|  '|
            If iWieksze > 1 Then Call wykonajSortowanie2D(tablicaWiekszych, czyRosnaco)             '|  '|
        End If                                                                                      '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    'Tablica końcowa zostaje poszerzona tak, żeby zmieściła wszystkie elementy z tablicy wejściowej -----|
    ReDim Preserve tablicaDocelowa(1 To 2, mniejszeIndeks To wiekszeIndeks)                             '|
    iWiersz = mniejszeIndeks                                                                            '|
    '----------------------------------------------------------------------------------------------------|


    'Jeżeli kolejność sortowania jest ustawiona na rosnącą, do tablicy wynikowej najpierw będą ----------|
    'wrzucane elementy z podtablicy [tablicaMniejszych].                                                '|
    'Jeżeli kolejność sortowania jest ustawiona na malejącą, do tablicy wynikowej najpierw będą         '|
    'wrzucane elementy z podtablicy [tablicaWiekszych].                                                 '|
    If czyRosnaco Then                                                                                  '|
        Call wykonajSortowanie2D_wstaw(tablicaDocelowa, tablicaMniejszych, iMniejsze, iWiersz)          '|
    Else                                                                                                '|
        Call wykonajSortowanie2D_wstaw(tablicaDocelowa, tablicaWiekszych, iWieksze, iWiersz)            '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    'Teraz do tablicy wynikowej zostaje wrzucony element bazowy (czyli pierwszy element w tablicy -------|
    'źródłowej, tak aby oddzielał wartości mniejsze od siebie i większe od siebie.                      '|
    tablicaDocelowa(1, iWiersz) = tablica(1, mniejszeIndeks)                                            '|
    tablicaDocelowa(2, iWiersz) = tablica(2, mniejszeIndeks)                                            '|
    iWiersz = iWiersz + 1                                                                               '|
    '----------------------------------------------------------------------------------------------------|


    'Na końcu elementy z podtablicy [tablicaWiekszych] lub [tablicaMniejszych] (w zależności od ---------|
    'wartości parametru [czyRosnaco]) są wrzucane do tablicy wynikowej.                                 '|
    If czyRosnaco Then                                                                                  '|
        Call wykonajSortowanie2D_wstaw(tablicaDocelowa, tablicaWiekszych, iWieksze, iWiersz)            '|
    Else                                                                                                '|
        Call wykonajSortowanie2D_wstaw(tablicaDocelowa, tablicaMniejszych, iMniejsze, iWiersz)          '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    'Tablica wynikowa nadpisuje poprzednią zawartość tablicy źródłowej (w rzeczywistości zawiera ona nadal
    'te same elementy tylko posortowane w innej kolejności).
    tablica = tablicaDocelowa


End Sub




'**********************************************************************************************************
' Nazwa:                wykonajSortowanie2D_wstaw
' Autor:                mielk | 2013-03-13
'
' Opis:                 Podprocedura funkcji sortujTablice2D odpowiadajacą za wstawianie elementów do
'                       tablicy docelowej.
'
'
' Argumenty:
'   tablicaKoncowa      Odniesienie do końcowej tabeli-mapy.
'   tablica             Tablica tymczasowa, z której wartości mają zostać przeniesione do tablicy końcowej.
'   elementy            Liczba elementów w tablicy tymczasowej.
'   wiersz              Indeks wiersza w tablicy końcowej, na którym ma zostać dodany pierwszy element
'                       z tablicy tymczasowej.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2013-03-13        mielk           Utworzenie funkcji.
'**********************************************************************************************************
Private Sub wykonajSortowanie2D_wstaw(tablicaKoncowa() As Variant, tablica() As Variant, _
                                                                          elementy As Long, wiersz As Long)
    Const NAZWA_METODY As String = "wykonajSortowanie2D_wstaw"
    '------------------------------------------------------------------------------------------------------
    Dim jWiersz As Long
    '------------------------------------------------------------------------------------------------------


    'Jeżeli w podanej tablicy tymczasowej [tablica] znajdują się jakiekolwiek elementy ... --------------|
    If elementy Then                                                                                    '|
                                                                                                        '|
        '... to przejedź po wszystkich elementach tej tablicy i wstaw je do tablicy -----------------|  '|
        '[tablicaKoncowa] począwszy od indeksu podanego jako parametr [wiersz]                      '|  '|
        For jWiersz = 1 To elementy                                                                 '|  '|
            tablicaKoncowa(1, wiersz) = tablica(1, jWiersz)                                         '|  '|
            tablicaKoncowa(2, wiersz) = tablica(2, jWiersz)                                         '|  '|
            wiersz = wiersz + 1                                                                     '|  '|
        Next jWiersz                                                                                '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


End Sub




'**********************************************************************************************************
' 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