'**********************************************************************************************************
' Nazwa:                sortujTablice1D
' Autor:                mielk | 2013-04-26
'
' Opis:                 Procedura sortująca w wybranym porządku przekazaną tablicę jednowymiarową.
'
'                       Procedura sortujTablice1D jest procedurą rekurencyjną - co oznacza, że w trakcie
'                       swojego działania wywołuje sama siebie.
'
'                       Omawiana procedura składa się z dwóch komponentów: głównej procedury
'                       sortujTablice1D oraz pomocniczą podprocedurę prywatną -
'                       sortujTablice1D_wstawWartosci, która oczywiście również musi być uwzględniona
'                       w kodzie, żeby procedura zadziałała prawidłowo.
'
' Argumenty:
'   tablica             Tablica, która ma zostać posortowana.
'                       Musi być tablicą jednowymiarową, w innym przypadku procedura zwróci wyjątek
'                       NiedozwolonaLiczbaWymiarow.
'   czyRosnaco          Argument opcjonalny.
'                       Decyduje o tym, czy przekazana do procedury tablica zostanie posortowana malejąco
'                       czy rosnąco.
'                       Domyślnie parametr ten przyjmuje wartość True, więc w przypadku jego pominięcia
'                       tablica zostanie posortowana rosnąco.
'
'
' Wyjątki:
'   NieTablica                      Wywoływany, kiedy podany argument wejściowy nie jest tablicą.
'   NiedozwolonaLiczbaWymiarow      Wywoływany, kiedy tablica podana jako argument wejściowy ma liczbę
'                                   wymiarów inną niż 1.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2013-04-26        mielk           Utworzenie funkcji.
'**********************************************************************************************************
Public Sub sortujTablice1D(tablica As Variant, Optional czyRosnaco As Boolean = True)
    Const NAZWA_METODY As String = "sortujTablice1D"
    '------------------------------------------------------------------------------------------------------
    Dim tablicaWiekszych() As Variant
    Dim tablicaMniejszych() As Variant
    Dim varWartoscBazowa As Variant
    Dim lngDolnaGranica As Long
    Dim lngGornaGranica As Long
    Dim lngWiersze As Long
    Dim lngLicznikMniejszych As Long
    Dim lngLicznikWiekszych As Long
    '------------------------------------------------------------------------------------------------------


    'Sprawdź czy podany parametr wejściowy jest tablicą i czy ma tylko jeden wymiar. --------------------|
    If Not VBA.IsArray(tablica) Then GoTo NieTablica                                                    '|
    If liczWymiary(tablica) <> 1 Then GoTo NiedozwolonaLiczbaWymiarow                                   '|
    '----------------------------------------------------------------------------------------------------|


    'Znajdź górną i dolną granicę tablicy źródłowej. ----------------------------------------------------|
    lngDolnaGranica = LBound(tablica, 1)                                                                '|
    lngGornaGranica = UBound(tablica, 1)                                                                '|
    '----------------------------------------------------------------------------------------------------|


    'Jeżeli górna granica tablicy jest mniejsza lub równa dolnej granicy, oznacza to, że tablica --------|
    'jest pusta lub posiada tylko jeden element - w obu tych sytuacjach sortowanie tablicy nie ma       '|
    'sensu, więc procedura kończy swoje działanie pozostawiając tablicę źródłową bez zmian.             '|
    If lngGornaGranica <= lngDolnaGranica Then GoTo NicDoSortowania                                     '|
    '----------------------------------------------------------------------------------------------------|


    'Zwiększ rozmiar tablic tymczasowych, tak żeby mogły pomieścić maksymalną liczbę elementów (czyli ---|
    'licznę elementów tablic źródłowej).                                                                '|
    ReDim Preserve tablicaMniejszych(1 To lngGornaGranica - lngDolnaGranica)                            '|
    ReDim Preserve tablicaWiekszych(1 To lngGornaGranica - lngDolnaGranica)                             '|
    '----------------------------------------------------------------------------------------------------|


    'Każdy element tablicy źródłowej jest porównywany do wartości bazowej (czyli do pierwszego ----------|
    'elementu tablicy źródłowej) i dodawany do odpowiedniej tablicy pomocniczej -                       '|
    '[tablicaMniejszych], jeżeli jest mniejszy od wartości bazowej lub [tablicaWiekszych], jeżeli       '|
    'jest większa od wartości bazowej.                                                                  '|
    If lngGornaGranica - lngDolnaGranica > 0 Then                                                       '|
                                                                                                        '|
        '--------------------------------------------------------------------------------------------|  '|
        For lngWiersze = lngDolnaGranica + 1 To lngGornaGranica                                     '|  '|
                                                                                                    '|  '|
            '------------------------------------------------------------------------------------|  '|  '|
            If tablica(lngWiersze) < tablica(1) Then                                            '|  '|  '|
                lngLicznikMniejszych = lngLicznikMniejszych + 1                                 '|  '|  '|
                tablicaMniejszych(lngLicznikMniejszych) = tablica(lngWiersze)                   '|  '|  '|
            Else                                                                                '|  '|  '|
                lngLicznikWiekszych = lngLicznikWiekszych + 1                                   '|  '|  '|
                tablicaWiekszych(lngLicznikWiekszych) = tablica(lngWiersze)                     '|  '|  '|
            End If                                                                              '|  '|  '|
            '------------------------------------------------------------------------------------|  '|  '|
                                                                                                    '|  '|
        Next lngWiersze                                                                             '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
                                                                                                        '|
        'Jeżeli tablica pomocnicza [tablicaMniejszych] zawiera jakiekolwiek wartości, posortuj ------|  '|
        'je poprzez rekurencyjne wywołanie tej funkcji.                                             '|  '|
        If lngLicznikMniejszych Then                                                                '|  '|
            ReDim Preserve tablicaMniejszych(1 To lngLicznikMniejszych)                             '|  '|
            If lngLicznikMniejszych > 1 Then Call sortujTablice1D(tablicaMniejszych, czyRosnaco)    '|  '|
        End If                                                                                      '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
                                                                                                        '|
        'Jeżeli tablica pomocnicza [tablicaWiekszych] zawiera jakiekolwiek wartości, posortuj -------|  '|
        'je poprzez rekurencyjne wywołanie tej funkcji.                                             '|  '|
        If lngLicznikWiekszych Then                                                                 '|  '|
            ReDim Preserve tablicaWiekszych(1 To lngLicznikWiekszych)                               '|  '|
            If lngLicznikWiekszych > 1 Then Call sortujTablice1D(tablicaWiekszych, czyRosnaco)      '|  '|
        End If                                                                                      '|  '|
        '--------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    'W tym miejscu tablica jest już posortowana dzięki rekurencyjnym wywołaniom tej funkcji. ------------|
    'Teraz będą one dodawane do tablicy wynikowej.                                                      '|
    varWartoscBazowa = tablica(lngDolnaGranica)                                                         '|
    lngWiersze = lngDolnaGranica                                                                        '|
                                                                                                        '|
    'Jeżeli tablica ma być posortowana w porządku rosnącym, najpierw muszą zostać wstawione ---------|  '|
    'elementy z podtablicy [tablicaMniejszych].                                                     '|  '|
    'Dla porządku malejącego, najpierw dodawane będą elementy z podtablicy [tablicaWiekszych].      '|  '|
    If czyRosnaco Then                                                                              '|  '|
        Call sortujTablice1D_wstaw(tablica, tablicaMniejszych, lngLicznikMniejszych, lngWiersze)    '|  '|
    Else                                                                                            '|  '|
        Call sortujTablice1D_wstaw(tablica, tablicaWiekszych, lngLicznikWiekszych, lngWiersze)      '|  '|
    End If                                                                                          '|  '|
    '------------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    tablica(lngWiersze) = varWartoscBazowa                                                              '|
    lngWiersze = lngWiersze + 1                                                                         '|
                                                                                                        '|
    'Jeżeli tablica ma być sortowana rosnąco, w tym miejscu będą wrzucane elementy z podtablicy -----|  '|
    '[tablicaWiekszych]. Dla porządku malejącego teraz będą dodawane elementy z podtablicy          '|  '|
    '[tablicaMniejszych].                                                                           '|  '|
    If czyRosnaco Then                                                                              '|  '|
        Call sortujTablice1D_wstaw(tablica, tablicaWiekszych, lngLicznikWiekszych, lngWiersze)      '|  '|
    Else                                                                                            '|  '|
        Call sortujTablice1D_wstaw(tablica, tablicaMniejszych, lngLicznikMniejszych, lngWiersze)    '|  '|
    End If                                                                                          '|  '|
    '------------------------------------------------------------------------------------------------|  '|
                                                                                                        '|
    '----------------------------------------------------------------------------------------------------|


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

'----------------------------------------------------------------------------------------------------------
NieTablica:
    'Obsługa błędów dla sytuacji, kiedy argument podany do funkcji nie jest tablicą.

    GoTo PunktWyjscia


NiedozwolonaLiczbaWymiarow:
    'Obsługa błędów dla sytuacji, kiedy tablica podana do funkcji ma więcej niż jeden wymiar.

    GoTo PunktWyjscia


NicDoSortowania:
    'Podana tablica ma tylko jeden element lub w ogóle nie ma elementów. W takiej sytuacji jej sortowanie
    'nie ma sensu.
    GoTo PunktWyjscia

End Sub




'**********************************************************************************************************
' Nazwa:                sortujTablice1D_wstaw
' Autor:                mielk | 2013-04-26
'
' Opis:                 Podfunkcja odpowiedzialna za wstawianie posortowanych danych do tablicy wynikowej.
'
' Argumenty:
'   tablica             Tablica wynikowa.
'   tempTablica         Tymczasowa tablica, której elementy będą dodane do tablicy wynikowej.
'   elementy            Liczba elementów w tablicy tymczasowej.
'   wiersz              Indeks wiersza, od którego powinno rozpocząć się dodawanie elementów.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2013-04-26        mielk           Utworzenie funkcji.
'**********************************************************************************************************
Private Sub sortujTablice1D_wstaw(tablica As Variant, tempTablica() As Variant, elementy As Long, _
                                                                                            wiersz As Long)
    Const NAZWA_METODY As String = "sortujTablice1D_wstaw"
    '------------------------------------------------------------------------------------------------------
    Dim jWiersz As Long
    '------------------------------------------------------------------------------------------------------


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


    'Tymczasowa tablica nie jest już więcej potrzebna, więc jej zawartość zostaje wyczyszczona, żeby
    'zwolnić pamięć.
    Erase tempTablica


End Sub




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