Funkcja sortujTablice1D 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 sortujTablice1D 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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
'**********************************************************************************************************
' 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
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
'**********************************************************************************************************
' 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