Сортировка двухмерного массива

tolikt · 01 окт 2007, 23:24

Двухмерный (или двумерный) массив. Нужен рабочий код VBA сортировки этого массива по нескольким полям.

Т. е., например, массив данных DataArray(N, M).
Массив полей сортировки по порядку SortArray(K), т.е. если сортировать надо сначала по столбцу 1, затем по 3, потом по 6, потом по 2, то SortArray – массив из чисел 1,3,6,2.
Подразумевается. что Option Compare не важно. Сортировка по возрастанию, хотя можно добавить массив, где указано, какой столбец надо сортировать, по возрастанию, а какой – по убыванию. Сортировать надо весь массив, т.е. с 1-й по последнюю строки, но в общем случае – со строки n1 по строку n2.

Т. е. нужен процедура сортировки, которая бы запускалась в коде макроса примерно так:

Код: Выделить всё

SortMacro DataArray, SortArray, n1, n2

и на выходе получить отсортированный массив

Алгоритм сортировки тоже не важен, но лучше тот, которым сортируется область на листе. Т.е. если сортировать не надо, то и порядок расположения не меняется. Всякие алгоритмы быстрой сортировки (типа Шелла) часто меняют местами то строки, у которых одинаковые данные по полю сортировки.

Бросить данный массив, на лист, отсортировать, а затем обратно в массив – не пойдёт по многим причинам.

По интернету находил алгоритмы сортировки с кодами, но только для одномерных массивов. Сам пытался что-то сделать, но всё получается как-то коряво. Может, у кого-то есть готовый код?

Fatty · 01 окт 2007, 23:33

Посмотри как будет работать у тебя,
вроде пока глюков не было

Аргументы:
SourceArr - исходный двухмерный массив
iPos - номер столбца

Код: Выделить всё

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
' written by Fatty T.O.H. (c)2006 * all rights removed '
' SourceArr - two dimensional array '
' iPos - "column" number (starting from 1) '
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Public Function CoolSort(SourceArr As Variant, iPos As Integer) As Variant

Dim Check As Boolean
ReDim tmpArr(UBound(SourceArr, 2)) As Variant
Dim iCount As Integer
Dim jCount As Integer
Dim nCount As Integer

iPos = iPos - 1
Check = False

Do Until Check
Check = True
For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1
If SourceArr(iCount, iPos) > SourceArr(iCount + 1, iPos) Then
For jCount = LBound(SourceArr, 2) To UBound(SourceArr, 2)
tmpArr(jCount) = SourceArr(iCount, jCount)
SourceArr(iCount, jCount) = SourceArr(iCount + 1, jCount)
SourceArr(iCount + 1, jCount) = tmpArr(jCount)
Check = False
Next
End If
Next
Loop

CoolSort = SourceArr

End Function

~'J'~

tolikt · 03 окт 2007, 06:06

Не совсем то. Внимательнее к тексту первого сообщения.
Как написано в начале первого сообщения, сортировка нужна не по одному, а по нескольким столбцам (полям)

Пример Fatty как бы для двухмерного массива, но сортировка только по одному столбцу. А это принципиально ничем не отличается от сортировки одномернго массива.

Т.е. нужен код, аналогичный методу Sort (с Order1, Order2 и Order3) на листе. Но для массива, а не для области листа. Ещё раз прошу внимательнее прочитать первое сообщение: способ перенести из массива на лист, отсортировать, а потом обратно в массив - не подходит.

Dim_ok · 03 окт 2007, 10:02

решил "блестнуть" и стырил код вот отсюда:
http://forum.developing.ru/showthread.php?t=9863
чуток подкрутил тока

tolikt · 04 окт 2007, 10:39

Н-да.... Хорошо, что я не пошёл в преподаватели.... меня совершенно не понимают...

[noparse]Например, на листе в Range("A1

10") имеются данные:[/noparse]

6 5 8 8
6 6 6 6
8 6 8 6
6 6 6 5
5 8 8 8
8 7 7 8
8 7 7 6
5 5 6 6
5 7 7 8
5 7 8 7

После Данные-Сортировка-(по столбцу А, затем по В, затем по С), который макрорекордером записывается в виде

Код: Выделить всё

Range("A1 :D 10").Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
        , Order2:=xlAscending, Key3:=Range("C1"), Order3:=xlAscending, Header _
        :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

имеем отсортированные данные в следующем виде:
5 5 6 6
5 7 7 8
5 7 8 7
5 8 8 8
6 5 8 8
6 6 6 6
6 6 6 5
8 6 8 6
8 7 7 8
8 7 7 6

Т.е. сначала сортировка по столбцу А, затем по столбцу В, но не всего массива, а только тех строк, где одинаковое значение в столбце А. И т.д.

И подобная сортировка нужна применительно к массиву переменных.
Повторяю!!! Записать данные из массива на лист, отсортировать, а затем обратно в массив - не подходит!!!

Ну, вроде разжевал до упора... Даже сам понял :-)

Сам сумел сделать рабочий код. Сортировка по методу Шелла. Но сортировка проходит оооочень долго. По сравнению с методом Sort для Range на листе. Основная потеря времени - в нерациональном способе определения границ массива с одинаковыми данными в предыдущем столбце для сортировки данных внутри этих самых границ.

Ясно, что не совсем корректно писать про сортировку в данной теме. Т.к. это имеет отношение больше к алгоритмам, а не конкретно к VBA. В других языках, скорее всего, есть что-то типа Sort применительно к массиву переменных, но для VBA оно не проходит...

Fatty · 04 окт 2007, 15:38

Попробуй такой вариант:

Код: Выделить всё

'~~~~~~~~~~~~~ Sort for an arbitary table ~~~~~~~~~~~~'
' written by Fatty T.O.H. (c)2006 * all rights reserved '
' SourceArr - two dimensional array '
' sort text as in the table
' edited 9/30/07
' edited 10/04/07 - to sort by 3 columns
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Public Function MultColSort(SourceArr As Variant) As Variant

Dim Check As Boolean
ReDim tmpArr(UBound(SourceArr, 2)) As Variant
Dim iCount As Integer
Dim jCount As Integer
Dim nCount As Integer

Check = False

Do Until Check
Check = True

For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1
If SourceArr(iCount, 1) > SourceArr(iCount + 1, 1) Or _
SourceArr(iCount, 1) = SourceArr(iCount + 1, 1) And _
SourceArr(iCount, 2) > SourceArr(iCount + 1, 2) Or _
SourceArr(iCount, 2) = SourceArr(iCount + 1, 2) And _
SourceArr(iCount, 3) > SourceArr(iCount + 1, 3) Then
For jCount = LBound(SourceArr, 2) To UBound(SourceArr, 2)
tmpArr(jCount) = SourceArr(iCount, jCount)
SourceArr(iCount, jCount) = SourceArr(iCount + 1, jCount)
SourceArr(iCount + 1, jCount) = tmpArr(jCount)
Check = False
Next
End If
Next
Loop

MultColSort = SourceArr

End Function

~'J'~

Dim_ok · 07 окт 2007, 22:29

Толи ещё нужно оно, толи нет...
сортировка поочерёдная, по всем столбам, а если выборочно, изладить можно вместо цикла чтото вроде строки через инпут вставить: 1,6,2 для очерёдности сортировки

Pavel55 · 08 окт 2007, 11:11

Вот ещё пример сортировки двухмерного массива с помощью Recordset
http://hiprog.com/index.php?option=com_ ... =35&show=1

tolikt · 10 окт 2007, 13:18

Метод, наверное, для VB, а не для VBA. Или, скорее всего, судя по названию форума в той ссылке, для MS Access.

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

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

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

Надо что-то где-то как-то подключить из каких-то библиотек? Или всё дело в моём Excel 97?

tolikt · 03 апр 2008, 20:21

Второй вариант от Fatty работает, но О-О-О-О-ОЧЕНЬ ДОЛГО!!!! Для ~10000 строк метод Sort для листа работает почти мгновенно, а сортировка массива происходит несколько минут.

Интересно, как организован алгоритм сортировки во встроенном методе Sort? И почему все остальные самописные (или из умных книг) алгоритмы так разительно отличаются в худшую сторону? Тут под словом "алгоритм" имею ввиду не метод (пузырьковая, быстрая, вставками, Шелла и пр.), а именно реализация для Sort листа и для VBA? Или это уже проблема самого VBA?