|
Наисложнейшая сортировка!!
#36950946
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
Ссылка на профиль пользователя:
|
Участник
Откуда: мы пришли, кто мы, куда идем?
Сообщения: 6 294
|
|
lincoln,
тю напугали епт
25 строк кода, если не считать заполнение массива
код 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.
Sub SortingDouble()
Dim x() As String
ReDim x( 1 To 15 ) As String
x( 1 ) = "Болт М24-9gх55.109.40Х.019 ГОСТ 7796-70"
x( 2 ) = "Болт М30х2.0-6gх75.109.40Х.019 ГОСТ 7798-70"
x( 3 ) = "Болт М30-6gх160.109.40Х.019 ГОСТ 7798-70"
x( 4 ) = "Болт М6x25.46.019 ГОСТ 7802-81"
x( 5 ) = "Болт М6x60.66.019 ГОСТ 7795-70"
x( 6 ) = "Болт М6х16.46 ГОСТ 7802-81"
x( 7 ) = "Болт М6х16.46.019 ГОСТ 7802-81"
x( 8 ) = "Болт М6х16.58.00 ОСТ 23.1.434-75"
x( 9 ) = "Болт М6х16.66.019 ГОСТ 7802-81"
x( 10 ) = "Болт М6х20.46 ГОСТ 7802-81"
x( 11 ) = "Болт М14x50.66.019 ГОСТ 7796-70"
x( 12 ) = "Болт М14х100.66 ГОСТ 7795-70"
x( 13 ) = "Болт М14х100.66.019 ГОСТ 7795-70"
x( 14 ) = "Болт М14х1,5-6gх35.109.40Х ГОСТ 7798-70"
x( 15 ) = "Болт М14х1,5-6gх35.109.40Х.019 ГОСТ 7798-70"
Dim y( 1 To 15 , 1 To 5 ) As Variant
Set rs = New ADOR.Recordset
rs.Fields.Append "fulln", adVariant: rs.Fields.Append "M", adInteger: rs.Fields.Append "gost", adInteger
rs.Open
For i = 1 To UBound(x)
y(i, 1 ) = x(i)
y(i, 2 ) = Left(y(i, 1 ), 5 )
y(i, 3 ) = CLng(Replace(Replace(Replace(Left(Right(y(i, 1 ), Len(y(i, 1 )) - 5 ), 3 ), "x", ""), "х", ""), "М", ""))
y(i, 4 ) = Replace(Right(y(i, 1 ), Len(y(i, 1 )) - 3 - InStr( 1 , y(i, 1 ), "ОСТ", vbTextCompare)), ".", "")
y(i, 5 ) = CLng(Left(y(i, 4 ), InStr( 1 , y(i, 4 ), "-", vbTextCompare) - 1 ))
rs.AddNew: rs!fulln = y(i, 1 ): rs!gost = y(i, 5 ): rs!m = y(i, 3 ): rs.Update
Next i
rs.Sort = "gost ASC, m ASC "
Erase x: ReDim x( 1 To 15 ) As String
rs.MoveFirst
For i = 1 To UBound(x)
x(i) = rs!fulln
Debug.Print x(i): rs.MoveNext
Next i
rs.Close
End Sub
|
|
|
