Сортировка двумерного массива на VB (VBA)

Игорь, предлагаю на Ваш суд такой вариант сортировки (через временный лист). При сортировке 400к+ текстовых значений время сортировки составляет несколько секунд (для меньших объемов возможно и не требуется такой подход). На вход подается двумерный массив с двумя столбцами, сортировка по первому столбцу, заголовки - опционально.
P.S. табуляция с отступами в коде пропали во время вставки кода на данной страничке... так что извиняйте за такое форматирование

Sub SortValue(ByRef rInitArr As Variant)
Dim sTMPSh$
sTMPSh = "Sortir"
On Error Resume Next
If Sheets(sTMPSh) Is Nothing Then
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Select
Sheets(Sheets.Count).Name = sTMPSh
Else
With Sheets(sTMPSh)
.Select
.Cells.ClearContents
End With
End If
On Error GoTo 0
Application.DisplayAlerts = False
Application.EnableEvents = False
With ActiveWorkbook.Worksheets(sTMPSh)
.Range(.Cells(2, 1), .Cells(UBound(rInitArr), 2)) = rInitArr
.Cells(1, 1) = "Сортируемый столбец"
.Cells(1, 2) = "Второй строки"
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Cells(1, 1), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.SetRange Range(Cells(1, 1), Cells(UBound(rInitArr), 2))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
rInitArr = .Range(Cells(2, 1), Cells(UBound(rInitArr), 2))
.Delete
End With
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

При сортировке "скромного" массива на 400к+ строк через предложеннух функцию (первая по счету) комп ушел в "несознанку" на несколько десятков минут (терпение закончилось раньше)... Если-то же самое выполнить средствами Worksheet (т.е. стандартный фильтр и в нем сортировка) - сортировка занимает около 2,5 минут (без учета выгрузки содержимого массива на временный лист (код примерно такой range(cells(1,1), cells(ubound(sourcearr), 2)) = sourcearr (цикл по строкам массива в данном случае не требуется)) и повторного считывания в массив).
В связи с чем вопрос: при каких размерах массивов есть смысл использовать тот или иной метод сортировки (безусловно, если есть какая то статистика)? Значения текстовые, массив двумерный.

Привет!

Спасибо за труды!

nCount не нужен.

Вместо
ReDim tmpArr(UBound(SourceArr, 2)) As Variant
достаточно
dim vTmp as Variant

Спасибо за уточнение, Михаил!

А только мне кажется, что в пузырьке строка
For j& = LBound(arr) To UBound(arr) - 2 - i
должна быть
For j& = LBound(arr) To UBound(arr) - 1 - i
?? Пять лет прошло так-то...

Алексей, очень помогли, спасибо!

Спасибо!

Просто, большое человеческое спасибо! Двумерка заработала!

Здравствуйте,а как применить данную программу,только если в ячейках сортированной матрицы были квадраты чисел?

Искал алгоритм, набрел на этот, но написал свой.
Первый алгоритм неэффективный. Очень много перестановок, а это самая долгая операция.
Предлагаю более простой и сортировка по любому количеству столбцов в любом порядке. Кому надо направление сортировки и произвольные границы, можете доработать сами. Последняя строка массива передается, потому что массив может быть заполнен не весь

Private Sub SortArray(myArray, countRows, ParamArray sortC())
Dim cRA%, cR%, minR%, cS%, cE%, countC%, tempV
..For cRA = 0 To countRows - 1
....minR = cRA
....For cR = cRA + 1 To countRows - 1
......For cS = 0 To UBound(sortC)
........If myArray(cR, sortC(cS)) <> myArray(minR, sortC(cS)) Then
..........If myArray(cR, sortC(cS)) < myArray(minR, sortC(cS)) Then minR = cR
..........Exit For
........End If
......Next
....Next
....If minR > cRA Then
......'меняем местами строки
......For cC = 0 To UBound(myArray, 2)
........tempV = myArray(cRA, cC)
........myArray(cRA, cC) = myArray(minR, cC)
........myArray(minR, cC) = tempV
......Next
....End If
..Next
End Sub

Вызов: SortArray Ar, 5, 2, 0, 1
Ar - массив, 5 - последняя строка, 2, 0, 1 - столбцы для сортировки

Как записать массив на лист я указал в комментариях http://excelvba.ru/code/Array2worksheet#comment-2866
Для сортировки двумерного массива по нужному столбцу нужна другая функция (если нужно, напишу).

Огромное спасибо за помощь!

Можно ли использовать второй макрос (где можно выбрать столбец) для сортировки двумерного массива по 3-му столбцу, если в столбце не числа, а текст, т.е. упорядочить по алфавиту?
И еще, подскажите, (конечно, глупый вопрос, но если не спрашивать, то как тогда научиться?!) как эту функцию вызвать и как полученную отсортированную матрицу записать на лист Excel?
Заранее спасибо!

Очередная, применённая мною, функция из раздела "Обработка массивов".
Уже и не помню пятая или шестая, в течение достаточно короткого времени.
Все работает отлично.
Спасибо Вам за Ваш труд!

На самом деле не самая быстрая сортировка получается, особенна разница видна при >1000 строк и больше 3х столбцов. Я бы предложил Quick sort использовать. Примерно так:
где a() это массив, который нужно отсортировать (двумерный), n - это номер стобца по которому сортирует, а low и high это начальная и конечная строка диапазона, который нужно отсортировать, если нужно отсортировать весь массив, то естественно - это начало и конец массива

Public Sub aQSort2(ByRef a() As Variant, ByVal n As Integer, ByRef low As Long, ByRef high As Long)
Dim i As Long, j As Long, k As Long
Dim m As Variant, wsp As Variant
i = low
j = high
m = a(Round((i + j) \ 2), n)
Do Until i > j
Do While a(i, n) < m
i = i + 1
Loop
Do While a(j, n) > m
j = j - 1
Loop
If (i <= j) Then
For k = LBound(a, 2) To UBound(a, 2)
wsp = a(i, k)
a(i, k) = a(j, k)
a(j, k) = wsp
Next k
i = i + 1
j = j - 1
End If
Loop
If (low < j) Then aQSort2 a(), n, low, j
If (i < high) Then aQSort2 a(), n, i, high
End Sub

В матрице С(8,6) в каждом столбце расставить элементы по возрастанию и найти значение минимального элемента матрицы.
А сможете для этого программу написать на языке VBA.

спасибо! заодно новый метод вывода освоила)) написала вам в ICQ

При помощи датчика случайных чисел заполнить действительную квадратную матрицу A порядка N (N ввести с клавиатуры). Переставить строки матрицы так, чтобы сумма элементов строк была возрастающая. Вывести сумму элементов строк, а также матрицу A до и после преобразования.

Sub v7zad16()
 
Dim a() As Integer, N As Integer, b() As Integer, t As Double, jmax As Long
Dim i As Integer, j As Integer, k As Integer, kk As Integer
Sheets("Лист16").Select: Cells.Clear 
N = Val(InputBox("vved n"))
ReDim a(N, N + 1) 
ReDim b(N, N + 1)
Randomize Timer 
For i = 1 To N 
For j = 1 To N  
  a(i, j) = Rnd * 10
  Cells(i, j) = a(i, j)
  a(i, N + 1) = a(i, N + 1) + a(i, j) 
Next j
 Cells(i, N + 1) = a(i, N + 1) 
Next i
 
 
b(N, N + 1)=CoolSort (a(n,n+1),n+1)
 
End Sub

если так, то ругается

как его хоть вызвать то

да эт понятно. у меня это всё равно потом пересекается. а метод Sort мне не понравился. мягко говоря.
за сайт спасибо.

Полезный макрос. Спасибо. Жаль только, что формулы все херит.

Жаль, что сортирует только числовые данные, а работает быстро :)

Спасибо Вам огромнейшее! :)

Здравствуйте. А возможно применить сортировку массива по 2-му, третьему столбцу? Какой параметр следует изменить? Спасибо.