Transponuj tablicę


Funkcja transponujTablice korzysta podczas działania z innych nie-wbudowanych funkcji prezentowanych na tej stronie, które w związku z tym również muszą być umieszczone w kodzie projektu dla prawidłowego działania tej funkcji.

Nie uwzględnienie ich w kodzie spowoduje wygenerowanie błędu: Compile error: Sub or Function not defined.

Dodatkowe funkcje wykorzystywane w funkcji transponujTablice zostały wymienione poniżej. Klikając w nazwę każdej z nich przeniesiesz się do podstrony zawierającej jej kod:

Dodając powyższe funkcje, zwróć uwagę czy nie były one już wcześniej wykorzystywane w Twoim kodzie. Obecność w jednym projekcie VBA dwóch funkcji publicznych o identycznych nazwach spowoduje wygenerowanie błędu kompilacji o treści: Compile error: Ambiguous name detected: nazwa_funkcji.

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
'**********************************************************************************************************
' 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