Funkcja sortujTablice2D 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 sortujTablice2D 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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
'**********************************************************************************************************
' 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
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
'**********************************************************************************************************
' 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
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
'**********************************************************************************************************
' 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