'**********************************************************************************************************
' Nazwa:                transponujTablice
' Autor:                mielk | 2012-06-21
'
' Opis:                 Funkcja transponująca podaną tablicę dwuwymiarową.
'
'                       Funkcja pozwala obejść błędy, występujące podczas transponowania tablicy przy
'                       użyciu wbudowanej funkcji arkuszowej Application.WorksheetFunction.Transpose,
'                       na przykład przy próbie transpozycji tablicy liczącej więcej niż 65536 wierszy
'                       lub w sytuacji, gdy któryś z elementów transponowanej tablicy jest tekstem
'                       dłuższym niż 256 znaków.
'
' Argumenty:
'   tablica             Tablica, która ma być transponowana przez tę funkcję.
'                       Podana tablica musi mieć dokładnie dwa wymiary. Jeżeli przekazany do funkcji
'                       argument nie będzie tablicą lub będzie posiadał inną liczbę wymiarów, funkcja
'                       wygeneruje błąd i zwróci pustą wartość.
'
' Zwraca:
'   Array()             Tablica źródłowa po transpozycji.
'
'
' Wyjątki:
'   NieTablica                      Wywoływany, kiedy parametr wejściowy podany do tej funkcji nie jest
'                                   tablicą.
'   NiedozwolonaLiczbaWymiarow      Wywyoływany, kiedy tablica podana do tej funkcji ma więcej niż
'                                   dwa wymiary.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2012-06-21        mielk           Utworzenie funkcji.
'**********************************************************************************************************
Public Function transponujTablice(ByRef tablica As Variant) As Variant()
    Const NAZWA_METODY As String = "transponujTablice"
    '------------------------------------------------------------------------------------------------------
    Dim lngWiersze As Long                     'Rows iterator
    Dim lngKolumny As Long                  'Columns iterator
    Dim lSzerokosc As Long
    Dim lWysokosc As Long
    Dim stSzerokosc As Long
    Dim stWysokosc As Long
    Dim tempTablica() As Variant
    '------------------------------------------------------------------------------------------------------


    'Funkcja sprawdza czy podany parametr [tablica] jest w rzeczywistości tablicą. Jeżeli nie, wywoływany
    'jest wyjątek NieTablica.
    If Not czyZdefiniowanaTablica(tablica) Then GoTo NieTablica


    'Funkcja dokonuje tylko transpozycji tablic dwuwymiarowych, więc jeżeli przekazana została tablica
    'posiadająca inną liczbę wymiarów, funkcja kończy działanie zwracając pustą wartość
    If liczWymiary(tablica) <> 2 Then GoTo NiedozwolonaLiczbaWymiarow


    'Najpierw funkcja próbuje dokonać transpozycji przy użyciu arkuszowej funkcji Transpose. Jest to na
    'pewno najszybsza metoda i w większości przypadków próba transpozycji powinna zakończyć się
    'powodzeniem.
    'Zdarza się jednak, że wspomniana funkcja arkuszowa nie jest w stanie dokonać poprawnej transpozycji
    'i generuje błąd (np. kiedy transponowana tablica posiada zbyt dużo wierszy). Dzięki zastosowaniu
    'polecenia On Error Resume Next, wykonywanie funkcji nie zostanie jednak w takiej sytuacji zatrzymane,
    'ale przeniesione dalej, gdzie znajduje się druga metoda transpozycji, która jest wprawdzie wolniejsza,
    'ale odporna na wspomniane błędy.
    On Error Resume Next
    transponujTablice = Excel.Application.WorksheetFunction.Transpose(tablica)


    'Resetuje ignorowanie błędów.
    On Error GoTo 0


    'Funkcja sprawdza zawartość zmiennej transponujTablice. Jeżeli zmienna jest pusta, oznacza to, że
    'funkcja arkuszowa napotkała podczas próby transpozycji jakieś trudności i nie była w stanie jej
    'dokończyć. W takiej sytuacji wykonywana jest druga metoda transpozycji.
    'Jeżeli natomiast do zmiennej transponujTablice przypisana jest jakakolwiek zawartość, oznacza to, że
    'funkcja arkuszowa bez problemu wykonała swoje zadanie i nie ma potrzeby ręcznego transponowanie
    'tablicy.
    If Not czyZdefiniowanaTablica(transponujTablice) Then
        stSzerokosc = LBound(tablica, 1)
        stWysokosc = LBound(tablica, 2)
        lSzerokosc = UBound(tablica, 1)
        lWysokosc = UBound(tablica, 2)

        'Tymczasowej tablicy tempArray nadawane są rozmiary takie, jakie posiada tablica źródłowa,
        'z tym, że zmieniona została kolejność wymiarów - wiersze stają się kolumnami i odwrotnie.
        ReDim tempTablica(stWysokosc To lWysokosc, stSzerokosc To lSzerokosc)
        For lngWiersze = stSzerokosc To lSzerokosc
            For lngKolumny = stWysokosc To lWysokosc
                tempTablica(lngKolumny, lngWiersze) = tablica(lngWiersze, lngKolumny)
            Next lngKolumny
        Next lngWiersze

        'Do zmiennej wynikowej przypisywana jest wygenerowana chwilę wcześniej tablica.
        transponujTablice = tempTablica

    End If


'==========================================================================================================
PunktWyjscia:
    Exit Function


'----------------------------------------------------------------------------------------------------------
NieTablica:
    'Obsługa błędów dla sytuacji, kiedy parametr wejściowy [tablica] nie jest tablicą.
    GoTo PunktWyjscia

NiedozwolonaLiczbaWymiarow:
    'Obsługa błędów dla sytuacji, kiedy podana tablica wejściowa ma więcej niż dwa wymiary.
    GoTo PunktWyjscia

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