Сортировка работает некорректно

@Saliery · Регистрация: 27.01.2013

Студворк — интернет-сервис помощи студентам

Доброго времени суток! Есть сортировка. Она работает идеально только в случае, когда один столбец (в массиве кроме числе больше ничего нет).
У меня данные в таком виде:

массив dat_ls
01.01.2028 01.01.2017 123
01.02.2014 05.07.2014 456
01.05.2026 07.01.2019 000

Надо отсортировать данные по 1-му или 2-му столбцу так, чтобы данные сохранились (как в EXCEL).
А данные сохраняются только в том столбце, который сортируется.

Помогите, пожалуйста, как мне видоизменить код, чтобы данные совместно сортировались?

Visual Basic
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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
'Запуск сортировки--------------------------------------
 
Dim dt1() As String
 
dt1 = SortArrayMinMaxZnV1(dat_ls, 0, 1, 0)
 
'//Запуск сортировки------------------------------------
 
'Сам код--------------------------------------
 
Public Function SortArrayMinMaxZnV1(ByRef in_arr() As String, ByVal MinMax As LogVar, ByVal NmbStlb As Byte, ByVal SW_Type As Boolean) As String()
 
'SW_Type=1 - сортировка по числам, 0- по дате
 
Dim max_val As Variant
Dim i As Long
Dim x As Long
Dim m As Long
 
 
Dim tmp As Variant
Dim tmp1 As String
 
m = 0
x = 0
 
If MinMax = 0 Then 'минимум
 
If SW_Type = 0 Then
 
max_val = CDate("01.01.4099")
 
Else
 
max_val = Val(10000)
 
 
End If
 
 
Else
 
 
If SW_Type = 0 Then
 
max_val = CDate("01.01.1099")
Else
 
max_val = Val(-9999)
 
 
End If
 
 
End If
 
 
M4:
 
For i = m To UBound(in_arr)
 
tmp = ParseStrDIV(Chr(9) & in_arr(i) & Chr(9), Chr(9), Chr(9), NmbStlb - 1)
 
If MinMax = 0 Then 'минимум
 
If SW_Type = 0 Then
 
tmp = CDate(tmp)
Else
 
tmp = Val(tmp)
 
End If
 
 
If (tmp < max_val) Then
max_val = tmp
x = i
End If
Else
If (tmp > max_val) Then
max_val = tmp
x = i
End If
End If
 
Next i
 
in_arr(x) = in_arr(m)
 
in_arr(m) = ReplaceCell_InStr(in_arr(m), NmbStlb, CStr(max_val))
 
If MinMax = 0 Then 'минимум
If SW_Type = 0 Then
 
max_val = CDate("01.01.4099")
 
Else
 
max_val = Val(10000)
 
 
End If
 
Else
 
If SW_Type = 0 Then
 
max_val = CDate("01.01.1099")
Else
 
max_val = Val(-9999)
 
End If
End If
m = m + 1
If m <= UBound(in_arr) Then GoTo M4
 
SortArrayMinMaxZnV1 = in_arr
 
End Function
 
Public Function ParseStrDIV(ByVal sourc_str As String, ByVal str_div1 As String, ByVal str_div2 As String, ByVal PN As Integer) As String
 
Dim p As Integer
Dim m As Integer
 
PN = PN + 1
 
If str_div1 = vbNullString Then
m = 1
GoTo M4
End If
 
If str_div2 = vbNullString Then
p = Len(sourc_str)
m = CountInSTR(sourc_str, str_div1, PN) + 1
ParseStrDIV = Mid(sourc_str, m, p)
Exit Function
End If
 
m = CountInSTR(sourc_str, str_div1, PN) + 1
 
M4:
 
If m = 1 Then
p = CountInSTR(sourc_str, str_div2, PN) + 1
Else
p = CountInSTR(sourc_str, str_div2, PN + 1) + 1
If m > p Then p = CountInSTR(sourc_str, str_div2, PN - 1) + 1
End If
 
If m = p Then
ParseStrDIV = Mid(sourc_str, m, Len(sourc_str) - m + 1)
Else
 
If Len(str_div1) > 1 And Len(str_div2) > 1 Then
ParseStrDIV = Mid(sourc_str, Len(str_div1) + 1, p - Len(str_div2) - 1)
Else
ParseStrDIV = Mid(sourc_str, m, p - m - 1)
End If
 
End If
 
 
End Function
 
Public Function ReplaceCell_InStr(ByVal str_dat As String, ByVal NumbStlb As Byte, ByVal repl_dat As String) As String
 
 
 
 
Dim i As Long
 
Dim lft_s As String
Dim rgt_s As String
 
Dim sum_s As String
 
'Dim tmp_s As String
 
'Dim len_str As Integer
 
'str_dat = Chr(9) & str_dat & Chr(9)
 
'If NumbStlb = 1 Then NumbStlb = 0
 
'len_str = CountInSTR(str_dat, Chr(9), NumbStlb)
 
lft_s = ParseStrDIV(Chr(9) & str_dat, vbNullString, Chr(9), NumbStlb - 1)
 
 
'If NumbStlb = 0 Then NumbStlb = 1
rgt_s = ParseStrDIV(Chr(9) & str_dat & Chr(9), Chr(9), vbNullString, NumbStlb)
 
sum_s = Replace(lft_s & Chr(9) & repl_dat & Chr(9) & rgt_s, Chr(9) & Chr(9), Chr(9))
 
'if
 
'If ParseStrDIV(sum_s, Chr(9), vbNullString, 0) = Chr(9) Then sum_s = Left(sum_s, Len(sum_s) - 1)
'If ParseStrDIV(sum_s, vbNullString, Chr(9), 0) = Chr(9) Then sum_s = Right(sum_s, Len(sum_s) - 1)
 
ReplaceCell_InStr = sum_s 'Replace(lft_s & Chr(9) & repl_dat & Chr(9) & rgt_s, Chr(9) & Chr(9), Chr(9))
 
End Function
 
Public Function CountInSTR(ByVal str As String, ByVal find_str As String, Optional ByVal p_numb As Long = 0) As Long
 
Dim x As Long
Dim cnt_count As Long
Dim tmp_temp As Long
 
'x = InStr(1, str, find_str)
 
' p_numb - ģīęķī óźąēąņü ķīģåš żėåģåķņą ļī ń÷øņó ā ńņšīźå, ÷ņīįū ļīėó÷čņü äėčķó äī ķåćī
 
'Dim y As Long
 
If p_numb = 0 Then p_numb = Len(str)
 
 
For x = 1 To p_numb 'Len(str)
 
cnt_count = InStr(cnt_count + 1, str, find_str)
If cnt_count = 0 Then Exit For
tmp_temp = cnt_count
'y = y + 1
Next x
 
CountInSTR = tmp_temp
 
End Function
 
'//Сам код------------------------------------

@Catstail · 16.10.2017, 17:15

Честно говоря, не хочется копаться в плохо отформатированном (записанным в колонку) коде... К тому же использующем неописанные пользовательские типы данных (LogVar). Проще все написать "с нуля":

Visual Basic
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
Sub Sort_(Arr() As String, nCol As Integer)
 
    s% = LBound(Arr, 1)
    e% = UBound(Arr, 1)
    
    For i% = s% To e% - 1
        For j% = i% + 1 To e%
            If CDate(Arr(i%, nCol%)) > CDate(Arr(j%, nCol%)) Then
               For k% = LBound(Arr, 2) To UBound(Arr, 2)
                   tmp$ = Arr(i%, k%)
                   Arr(i%, k%) = Arr(j%, k%)
                   Arr(j%, k%) = tmp$
               Next k%
            End If
        Next j%
    Next i%
 
End Sub
 
Sub Test()
 
Dim X(1 To 3, 1 To 3) As String
 
    X(1, 1) = "01.01.2028"
    X(1, 2) = "01.01.2017"
    X(1, 3) = "123"
    X(2, 1) = "01.02.2014"
    X(2, 2) = "05.07.2014"
    X(2, 3) = "456"
    X(3, 1) = "01.05.2026"
    X(3, 2) = "07.01.2019"
    X(3, 3) = "000"
 
    Debug.Print "Сортировка по 1-й колонке"
    Debug.Print
 
    Sort_ X, 1
 
    For i% = 1 To 3
        For j% = 1 To 3
            Debug.Print X(i%, j%); " ";
        Next j%
        Debug.Print
    Next i%
 
    Debug.Print
    Debug.Print "Сортировка по 2-й колонке"
    Debug.Print
    
    Sort_ X, 2
 
    For i% = 1 To 3
        For j% = 1 To 3
            Debug.Print X(i%, j%); " ";
        Next j%
        Debug.Print
    Next i%
 
    Debug.Print
    
End Sub

Вот как это работает:

Code
1
2
3
4
5
6
7
8
9
10
11
Сортировка по 1-й колонке
 
01.02.2014 05.07.2014 456 
01.05.2026 07.01.2019 000 
01.01.2028 01.01.2017 123 
 
Сортировка по 2-й колонке
 
01.02.2014 05.07.2014 456 
01.01.2028 01.01.2017 123 
01.05.2026 07.01.2019 000

@Saliery · 16.10.2017, 21:48 **[ТС]**

Catstail, огромное спасибо!

Новые блоги и статьи Все статьи Все блоги /
Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	[В процессе разработки] SDL3 для Web (WebAssembly): Сборка библиотек SDL3 и Box2D из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .
Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»

@Saliery 9 / 9 / 4 Регистрация: 27.01.2013 Сообщений: 451
	16.10.2017, 21:48 [ТС]
	Catstail, огромное спасибо! 0

Сортировка работает некорректно

Решение