Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Сортировка массива. Код - аналог Sort для Range на листе / 14 сообщений из 14, страница 1 из 1
06.10.2007, 17:55
    #34851890
tolikt
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
Есть функция Sort для Range на листе. Нужен аналог этой функции в VBA для сортировки двумерного массива переменных.
Т.е. Сортировка по нескольким полям. При равных значениях порядок оставлять изначальным.
И главное: сортировка массива должна быть такой же быстрой, как функция Sort.
Может быть, через Recordset? Жаль, ничего в нём не понимаю.
Записать из массива на лист, отсортировать, а затем обратно в массив - не подойдёт.
...
Рейтинг: 0 / 0
08.10.2007, 10:19
    #34853131
big-duke
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
...
Рейтинг: 0 / 0
10.10.2007, 13:09
    #34859973
tolikt
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
Метод, наверное, для VB, а не для VBA.

Возникает куча ошибок компиляции, начиная со строки
Option Compare Database

Все перечислять не буду. Далее ошибки типа "Переменная не определена", "Не описан пользовательский тип" и т.п. А имеющееся выражение "</font>" наверное просто опечатка.
Особо не понятен список аргументов в строке
SortArr myArr, Array(adInteger, adVarChar, adDouble, adCurrency, adDate), "6 ASC, 2 DESC"

У кого-нибудь получилось запустить данный код?

Надо что-то где-то как-то подключить из каких-то библиотек? Или всё дело в моём Excel 97?
...
Рейтинг: 0 / 0
10.10.2007, 13:46
    #34860131
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
Дело в том что VBA есть не только в EXCEL.
Тот пример для Access (хотя его тоже нодо править)

Вот для EXCEL только в референс подключи Microsoft ActiveX DataObjects 2.X Library

Код: plaintext
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.
Option Explicit

Public Sub InitArr()
Dim X, Y
Dim myArr( 5  To  14 ,  2  To  6 )
'Заполняем массив
  For X =  5  To  14 
    myArr(X,  2 ) = Int(( 100  * Rnd) +  1 )
    For Y =  1  To Int(( 10  * Rnd) +  1 )
       myArr(X,  3 ) = myArr(X,  3 ) & Chr(Int(( 70  * Rnd) +  1 ) +  47 )
    Next Y
    myArr(X,  4 ) = CDbl(Int(( 5000  * Rnd) +  1 ) /  7 )
    myArr(X,  5 ) = CCur(Int(( 5000  * Rnd) +  1 ) /  7 )
    myArr(X,  6 ) = CDate(Date - Int(( 3  * Rnd) +  1 ))
    Debug.Print myArr(X,  2 ); Tab; myArr(X,  3 ); Tab; myArr(X,  4 ); Tab; myArr(X,  5 ); Tab; myArr(X,  6 )
  Next X
    
Debug.Print "==================="
    
'Сортируем массив
SortArr myArr, Array(adInteger, adVarChar, adDouble, adCurrency, adDate), "6 ASC, 2 DESC"
For X =  5  To  14 
    Debug.Print myArr(X,  2 ); Tab; myArr(X,  3 ); Tab; myArr(X,  4 ); Tab; myArr(X,  5 ); Tab; myArr(X,  6 )
Next X
End Sub
 
'Собственно функция сортировки

Public Sub SortArr(ByRef myArr, arrDataType, strSort As String)
Dim X, I, Y, myArrS
Dim rst As New ADODB.Recordset

With rst
'Создаем рекордсет
  With .Fields
      X = LBound(myArr,  2 )
      For Each myArrS In arrDataType
         If myArrS =  129  Or myArrS =  200  Then _
             .Append X, myArrS,  255  _
         Else: .Append X, myArrS
               X = X +  1 
      Next
  End With
  .CursorLocation = adUseClient
  .Open
        
'Заполняем рекордсет
    For I = LBound(myArr,  1 ) To UBound(myArr,  1 )
      .AddNew
      For Y =  0  To UBound(myArr,  2 ) - LBound(myArr,  2 )
        .Fields(Y) = myArr(I, Y + LBound(myArr,  2 ))
      Next Y
   Next I
        
'Сортируем
        .Sort = strSort
        .MoveFirst
'Заполняем массив
   For I = LBound(myArr,  1 ) To UBound(myArr,  1 )
      For Y =  0  To UBound(myArr,  2 ) - LBound(myArr,  2 )
         myArr(I, Y + LBound(myArr,  2 )) = Trim$(.Fields(Y))
      Next Y
      .MoveNext
   Next I
        
   .Close
End With
Set rst = Nothing
End Sub
...
Рейтинг: 0 / 0
10.10.2007, 15:39
    #34860694
Chelovek Tapok
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
Я в свое время сам задался этим вопросом и пришел при помощи Уокенбаха и своих дополнительных изменений к следующим сортировкам:
Код: plaintext
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.
'Option Explicit
'Сортирует только численные массивы, очень эффективно ("сортировка методом пересчета")
Sub Countingsort(List, n, k)
    Dim counts() As Long
    Dim i As Long
    Dim j As Long
    Dim next_index As Long
    Dim min, max
    Dim min_value As Variant, max_value As Variant

    min_value = Minimum(List, n, k)
    max_value = Maximum(List, n, k)

    min = n
    max = k
    
    ReDim counts(min_value To max_value)
    
    'Подсчет значений.
    For i = min To max
        counts(List(i,  1 )) = counts(List(i,  1 )) +  1 
    Next i

    'Повторное занесение значений в массив.
    next_index = min
    For i = min_value To max_value
        For j =  1  To counts(i)
            List(next_index,  1 ) = i
            next_index = next_index +  1 
        Next j
    Next i
End Sub

Private Function Maximum(l, nac, kon)
    Dim S1, s2
    Dim i
    S1 = nac
    s2 = kon
    Maximum = l(S1,  1 )
    For i = S1 To s2
        If l(i,  1 ) > Maximum Then Maximum = l(i,  1 )
    Next i
End Function

Private Function Minimum(l, nac, kon)
    Dim S1, s2
    Dim i
    S1 = nac
    s2 = kon
    Minimum = l(S1,  1 )
    For i = S1 To s2
        If l(i,  1 ) < Minimum Then Minimum = l(i,  1 )
    Next i
End Function
...
Рейтинг: 0 / 0
10.10.2007, 15:40
    #34860698
Chelovek Tapok
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
и еще
Код: plaintext
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.
'Сортирует все, ("быстрая сортировка")
'n - строка с которой начнется сортировка
'k - строка на которой сортировка закончится
'Shirina - ширина массива
'Stolbec - столбец по которому будет идти сортировка
Sub QuickSortByStolbec(massiv() As String, n, k, Shirina, Stolbec)
    Dim S As Long, l As Long, r As Long, i As Integer
    Dim shablon() As String
    Dim g As Boolean
    
    S = Int((n + k) /  2 )
    l = n
    r = k
    g = False
    ReDim shablon( 1  To Shirina)
    
    Do Until g = True
        Do Until massiv(l, Stolbec) > massiv(S, Stolbec) Or S = l
            l = l +  1 
        Loop
        
        Do Until massiv(r, Stolbec) < massiv(S, Stolbec) Or r = S
            r = r -  1 
        Loop
        
        If r = S Then
            If l = S Then
                g = True
                If S - n >  1  Then
                    Call QuickSortByStolbec(massiv(), n, S -  1 , Shirina, Stolbec)
                End If
                If k - S >  1  Then
                    Call QuickSortByStolbec(massiv(), S +  1 , k, Shirina, Stolbec)
                End If
            Else
                S = Int((l + r) /  2 )
                For i =  1  To Shirina
                    shablon(i) = massiv(r, i)
                    massiv(r, i) = massiv(l, i)
                    massiv(l, i) = massiv(S, i)
                    massiv(S, i) = shablon(i)
                Next i
                r = r -  1 
            End If
        Else
            If l = S Then
                S = Int((l + r) /  2 ) +  1 
                For i =  1  To Shirina
                    shablon(i) = massiv(l, i)
                    massiv(l, i) = massiv(r, i)
                    massiv(r, i) = massiv(S, i)
                    massiv(S, i) = shablon(i)
                Next i
                l = l +  1 
            Else
                For i =  1  To Shirina
                    shablon(i) = massiv(l, i)
                    massiv(l, i) = massiv(r, i)
                    massiv(r, i) = shablon(i)
                Next i
            End If
        End If
    Loop
End Sub
...
Рейтинг: 0 / 0
10.10.2007, 20:31
    #34861591
White Owl
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
А можно еще проще.
создать новый лист в своей книге, скопировать свой массив на свежесозданый лист, отсортировать область, скопировать область в массив, убить лист.
...
Рейтинг: 0 / 0
10.10.2007, 23:14
    #34861697
Chelovek Tapok
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
White Owl А можно еще проще.
создать новый лист в своей книге, скопировать свой массив на свежесозданый лист, отсортировать область, скопировать область в массив, убить лист.

Согласен, но в свое время мне приходилось сортировать массивы до 100000 строк в Excel2003.
...
Рейтинг: 0 / 0
11.10.2007, 01:13
    #34861777
White Owl
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
Chelovek Tapok White Owl А можно еще проще.
создать новый лист в своей книге, скопировать свой массив на свежесозданый лист, отсортировать область, скопировать область в массив, убить лист.Согласен, но в свое время мне приходилось сортировать массивы до 100000 строк в Excel2003.хосссподи... ну зачем? зачем такие объемы обрабатывать в Экселе? Не мучайте животное, не предназначено оно для этого.
...
Рейтинг: 0 / 0
03.04.2008, 19:09
    #35234122
tolikt
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
В варианте vkodor на строке (примерно №39)
Код: plaintext
             .Append X, myArrS,  255 
вылетает: "Ошибка выполнения '3367' Объект уже имеется в семействе. Добавление невозможно."
...
Рейтинг: 0 / 0
04.04.2008, 10:54
    #35235023
f
f
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
White Owl Не мучайте животное
Присоединяюсь!
...
Рейтинг: 0 / 0
07.04.2008, 23:00
    #35241149
tolikt
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
"быстрая сортировка" от "Chelovek Tapok" работает, но пришлось переменные массива описать как Variant, т.к. как при String сортировка чисел была глючная.
Сортировка более правильная, т.к. учитывает дефисы. Sort на листе их почему-то игнорирует. Описано в теме Сортировка (косяк)

К сожалению, сам так и не разобрался, как сделать сортировку не по одному, а по нескольким столбцам.
И ещё. Данный алгоритм есть аналог метода Sort на листе при равных значениях строк в массиве? Т.е., если попадаются одинаковые значения по сортируемому столбцу, то они не должны менять порядок между собой: то, что было первее, там и должно остаться.

Жаль, по поводу ошибки в коде для сортировки через Recordset ответа так и нет....
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
03.06.2011, 13:02
    #37293307
tolikt
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
вопрос по сортировке рекордсетом до сих актуален.........
...
Рейтинг: 0 / 0
03.06.2011, 14:33
    #37293545
_slan_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Сортировка массива. Код - аналог Sort для Range на листе
tolikt, была похожая тема в ветке по VB. я там отвечал.

по "результатам" ( в кавычках - так как результатов особенно не было) написал вот что: см влож.

программа-пример использования находится там же:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
Sub t()
Dim arr( 1  To  9 ,  1  To  3 ), r
r = [a1:c9]
For i =  1  To  9 
For j =  1  To  3 
arr(i, j) = r(i, j)
Next
Next
Call [color=red]sort_range(arr)[/color]
[a1:c9] = arr
End Sub
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Сортировка массива. Код - аналог Sort для Range на листе / 14 сообщений из 14, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]