Всем добрый день. Помогите пожалуйста понять, что нужно сделать в моем коде ниже, чтобы двумерный массив сортировался по возрастанию не в каждой строке отдельно(как сейчас), независимо от значений в других строках массива, а так , чтобы массив сортировался полностью , то есть чтобы Первый элемент массива был минимальным, а последний элемент в последней строке в последнем столбце был максимальным?
Option Explicit Sub sort()
Dim i AsInteger, j AsInteger Dim WSh As Worksheet Dim n AsInteger, l AsInteger, c AsInteger Dim V() AsLong Dim r As Range, temp AsLong
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2
n = InputBox("введите размер двумерного массива", "массив", 3) ReDim V(1To n, 1To n) ' иннициация 2-мерного массива
For i = 1To n For j = 1To n
WSh.Cells(i, j).Value = WorksheetFunction.Round(Rnd * 1000, 0) ' заполнение рандомными числами Листа2
V(i, j) = WSh.Cells(i, j).Value ' заполнение 2-мерного массива рандомными числами Next j Next i ' Сортировка полученного 2-мерного массива пузырьком( каждая строка сортируется отдельно по-возрастанию, независимо от значений в других строках массива) For c = 1To n ' цикл для перебора строк 2-мерного массива, которые надо сортировать For i = 1To n ' начало сортировки отдельной строки методом пузырька For j = 1To n - 1 If V(c, j) > V(c, j + 1) Then
temp = V(c, j + 1)
V(c, j + 1) = V(c, j)
V(c, j) = temp EndIf Next j Next i ' конец сортировки отдельной строки методом пузырька Next c ' приступаем к сортировке следующей строки 2-мерного массива
Всем добрый день. Помогите пожалуйста понять, что нужно сделать в моем коде ниже, чтобы двумерный массив сортировался по возрастанию не в каждой строке отдельно(как сейчас), независимо от значений в других строках массива, а так , чтобы массив сортировался полностью , то есть чтобы Первый элемент массива был минимальным, а последний элемент в последней строке в последнем столбце был максимальным?
Option Explicit Sub sort()
Dim i AsInteger, j AsInteger Dim WSh As Worksheet Dim n AsInteger, l AsInteger, c AsInteger Dim V() AsLong Dim r As Range, temp AsLong
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2
n = InputBox("введите размер двумерного массива", "массив", 3) ReDim V(1To n, 1To n) ' иннициация 2-мерного массива
For i = 1To n For j = 1To n
WSh.Cells(i, j).Value = WorksheetFunction.Round(Rnd * 1000, 0) ' заполнение рандомными числами Листа2
V(i, j) = WSh.Cells(i, j).Value ' заполнение 2-мерного массива рандомными числами Next j Next i ' Сортировка полученного 2-мерного массива пузырьком( каждая строка сортируется отдельно по-возрастанию, независимо от значений в других строках массива) For c = 1To n ' цикл для перебора строк 2-мерного массива, которые надо сортировать For i = 1To n ' начало сортировки отдельной строки методом пузырька For j = 1To n - 1 If V(c, j) > V(c, j + 1) Then
temp = V(c, j + 1)
V(c, j + 1) = V(c, j)
V(c, j) = temp EndIf Next j Next i ' конец сортировки отдельной строки методом пузырька Next c ' приступаем к сортировке следующей строки 2-мерного массива
Sub sort() Dim i AsInteger, j AsInteger Dim WSh As Worksheet Dim n AsInteger, c AsInteger Dim V() AsLong Dim b AsBoolean
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2
n = InputBox("введите размер двумерного массива", "массив", 3) If n > Int((2 ^ 15 - 1) ^ 0.5) Then Err.Raise 6'максимальное значение integer = 2^15-1 ReDim V(1To n, 1To n) ' иннициация 2-мерного массива
Randomize 'инициализация генератора случайных чисел For i = 1To n: For j = 1To n
V(i, j) = Int(Rnd * 1000) ' заполнение 2-мерного массива рандомными числами Next j, i With WSh.Cells(1).Resize(i - 1, j - 1)
.Value = V ' выгрузка массива на лист ' Сортировка полученного 2-мерного массива пузырьком For i = 0To n ^ 2 - 2: For j = i To n ^ 2 - 1
Swap V(i \ n + 1, i Mod n + 1), V(j \ n + 1, j Mod n + 1) Next j, i
.Offset(n + 1) = V() ' записываем отсортированные строки 2-мерного массива в Лист2 EndWith EndSub PrivateFunction Swap(ByRef a&, ByRef b&) If a > b Then: Dim c&: c = a: a = b: b = d EndFunction
Здравствуйте.
Sub sort() Dim i AsInteger, j AsInteger Dim WSh As Worksheet Dim n AsInteger, c AsInteger Dim V() AsLong Dim b AsBoolean
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2
n = InputBox("введите размер двумерного массива", "массив", 3) If n > Int((2 ^ 15 - 1) ^ 0.5) Then Err.Raise 6'максимальное значение integer = 2^15-1 ReDim V(1To n, 1To n) ' иннициация 2-мерного массива
Randomize 'инициализация генератора случайных чисел For i = 1To n: For j = 1To n
V(i, j) = Int(Rnd * 1000) ' заполнение 2-мерного массива рандомными числами Next j, i With WSh.Cells(1).Resize(i - 1, j - 1)
.Value = V ' выгрузка массива на лист ' Сортировка полученного 2-мерного массива пузырьком For i = 0To n ^ 2 - 2: For j = i To n ^ 2 - 1
Swap V(i \ n + 1, i Mod n + 1), V(j \ n + 1, j Mod n + 1) Next j, i
.Offset(n + 1) = V() ' записываем отсортированные строки 2-мерного массива в Лист2 EndWith EndSub PrivateFunction Swap(ByRef a&, ByRef b&) If a > b Then: Dim c&: c = a: a = b: b = d EndFunction
Решил вопрос полной сортироваки 2мерного массива аж 4мя вложенными циклами. Может есть какой-то более изящный и короткий метод?
Option Explicit Sub sort()
Dim i AsInteger, j AsInteger Dim WSh As Worksheet Dim n AsInteger, l AsInteger, fi AsInteger, fj AsInteger Dim V() AsLong Dim r As Range, temp AsLong
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2
n = InputBox("введите размер двумерного массива", "массив", 3) ReDim V(1To n, 1To n) ' иннициация 2-мерного массива
For i = 1To n For j = 1To n
WSh.Cells(i, j).Value = WorksheetFunction.Round(Rnd * 1000, 0) ' заполнение рандомными числами Листа2
V(i, j) = WSh.Cells(i, j).Value ' заполнение 2-мерного массива рандомными числами Next j Next i ' Сортировка полученного 2-мерного массива по возрастанию
For i = 1To n For j = 1To n For fi = 1To n For fj = 1To n If V(i, j) > V(fi, fj) Then
temp = V(fi, fj)
V(fi, fj) = V(i, j)
V(i, j) = temp EndIf Next fj Next fi Next j Next i
Решил вопрос полной сортироваки 2мерного массива аж 4мя вложенными циклами. Может есть какой-то более изящный и короткий метод?
Option Explicit Sub sort()
Dim i AsInteger, j AsInteger Dim WSh As Worksheet Dim n AsInteger, l AsInteger, fi AsInteger, fj AsInteger Dim V() AsLong Dim r As Range, temp AsLong
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2
n = InputBox("введите размер двумерного массива", "массив", 3) ReDim V(1To n, 1To n) ' иннициация 2-мерного массива
For i = 1To n For j = 1To n
WSh.Cells(i, j).Value = WorksheetFunction.Round(Rnd * 1000, 0) ' заполнение рандомными числами Листа2
V(i, j) = WSh.Cells(i, j).Value ' заполнение 2-мерного массива рандомными числами Next j Next i ' Сортировка полученного 2-мерного массива по возрастанию
For i = 1To n For j = 1To n For fi = 1To n For fj = 1To n If V(i, j) > V(fi, fj) Then
temp = V(fi, fj)
V(fi, fj) = V(i, j)
V(i, j) = temp EndIf Next fj Next fi Next j Next i
Исправил свой пост, написал фигню какую-то сгородил до кучи, QuickSort
Option Explicit Sub sort() Dim i AsInteger, j AsInteger Dim WSh As Worksheet Dim n AsInteger, c AsInteger Dim v() AsLong Dim b AsBoolean
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2
n = InputBox("введите размер двумерного массива", "массив", 3) If n > Int((2 ^ 15 - 1) ^ 0.5) Then Err.Raise 6'максимальное значение integer = 2^15-1 ReDim v(1To n, 1To n) ' иннициация 2-мерного массива
Randomize 'инициализация генератора случайных чисел For i = 1To n: For j = 1To n
v(i, j) = Int(Rnd * 1000) ' заполнение 2-мерного массива рандомными числами Next j, i With WSh.Cells(1).Resize(i - 1, j - 1)
.Value = v ' выгрузка массива на лист ' Сортировка полученного 2-мерного массива пузырьком
Quicksort v, 0, n ^ 2 - 1, n
.Offset(n + 1) = v() ' записываем отсортированные строки 2-мерного массива в Лист2 EndWith EndSub Sub Quicksort(ByRef values&(), ByVal min AsLong, ByVal max AsLong, n%)
Dim med_value AsString Dim hi AsLong Dim lo AsLong Dim i AsLong
' If the list has only 1 item, it's sorted. If min >= max ThenExitSub
' Pick a dividing item randomly.
i = min + Int(Rnd(max - min + 1))
med_value = values(i \ n + 1, i Mod n + 1)
' Swap the dividing item to the front of the list.
values(i \ n + 1, i Mod n + 1) = values(min \ n + 1, min Mod n + 1)
' Separate the list into sublists.
lo = min
hi = max Do ' Look down from hi for a value < med_value. DoWhile values(hi \ n + 1, hi Mod n + 1) >= med_value
hi = hi - 1 If hi <= lo ThenExitDo Loop
If hi <= lo Then ' The list is separated.
values(lo \ n + 1, lo Mod n + 1) = med_value ExitDo EndIf
' Swap the lo and hi values.
values(lo \ n + 1, lo Mod n + 1) = values(hi \ n + 1, hi Mod n + 1)
' Look up from lo for a value >= med_value.
lo = lo + 1 DoWhile values(lo \ n + 1, lo Mod n + 1) < med_value
lo = lo + 1 If lo >= hi ThenExitDo Loop
If lo >= hi Then ' The list is separated.
lo = hi
values(hi \ n + 1, hi Mod n + 1) = med_value ExitDo EndIf
' Swap the lo and hi values.
values(hi \ n + 1, hi Mod n + 1) = values(lo \ n + 1, lo Mod n + 1) Loop' Loop until the list is separated.
' Recursively sort the sublists.
Quicksort values, min, lo - 1, n
Quicksort values, lo + 1, max, n
EndSub
Исправил свой пост, написал фигню какую-то сгородил до кучи, QuickSort
Option Explicit Sub sort() Dim i AsInteger, j AsInteger Dim WSh As Worksheet Dim n AsInteger, c AsInteger Dim v() AsLong Dim b AsBoolean
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2
n = InputBox("введите размер двумерного массива", "массив", 3) If n > Int((2 ^ 15 - 1) ^ 0.5) Then Err.Raise 6'максимальное значение integer = 2^15-1 ReDim v(1To n, 1To n) ' иннициация 2-мерного массива
Randomize 'инициализация генератора случайных чисел For i = 1To n: For j = 1To n
v(i, j) = Int(Rnd * 1000) ' заполнение 2-мерного массива рандомными числами Next j, i With WSh.Cells(1).Resize(i - 1, j - 1)
.Value = v ' выгрузка массива на лист ' Сортировка полученного 2-мерного массива пузырьком
Quicksort v, 0, n ^ 2 - 1, n
.Offset(n + 1) = v() ' записываем отсортированные строки 2-мерного массива в Лист2 EndWith EndSub Sub Quicksort(ByRef values&(), ByVal min AsLong, ByVal max AsLong, n%)
Dim med_value AsString Dim hi AsLong Dim lo AsLong Dim i AsLong
' If the list has only 1 item, it's sorted. If min >= max ThenExitSub
' Pick a dividing item randomly.
i = min + Int(Rnd(max - min + 1))
med_value = values(i \ n + 1, i Mod n + 1)
' Swap the dividing item to the front of the list.
values(i \ n + 1, i Mod n + 1) = values(min \ n + 1, min Mod n + 1)
' Separate the list into sublists.
lo = min
hi = max Do ' Look down from hi for a value < med_value. DoWhile values(hi \ n + 1, hi Mod n + 1) >= med_value
hi = hi - 1 If hi <= lo ThenExitDo Loop
If hi <= lo Then ' The list is separated.
values(lo \ n + 1, lo Mod n + 1) = med_value ExitDo EndIf
' Swap the lo and hi values.
values(lo \ n + 1, lo Mod n + 1) = values(hi \ n + 1, hi Mod n + 1)
' Look up from lo for a value >= med_value.
lo = lo + 1 DoWhile values(lo \ n + 1, lo Mod n + 1) < med_value
lo = lo + 1 If lo >= hi ThenExitDo Loop
If lo >= hi Then ' The list is separated.
lo = hi
values(hi \ n + 1, hi Mod n + 1) = med_value ExitDo EndIf
' Swap the lo and hi values.
values(hi \ n + 1, hi Mod n + 1) = values(lo \ n + 1, lo Mod n + 1) Loop' Loop until the list is separated.
' Recursively sort the sublists.
Quicksort values, min, lo - 1, n
Quicksort values, lo + 1, max, n
Добрый день, а я использую вот такую функцию для сортирорвки
PublicFunction SortedRezult(Massiv AsVariant, SortColumn&) 'Massiv - двумерный массив 'SortColumn - колонка сортировки Dim Start!: Start = Timer Dim n&, j&, i& 'просто для цикла For...Next Dim TmpMas1() AsVariant: ReDim TmpMas1(LBound(Massiv, 2) ToUBound(Massiv, 2)) AsVariant OnErrorResumeNext For i = LBound(Massiv, 1) ToUBound(Massiv, 1) Step1'просматриваем все строки массива с верхней до нижней границы For j = LBound(Massiv, 2) ToUBound(Massiv, 2)
TmpMas1(j) = Massiv(i, j) 'заполняем временный массив Next j For n = i ToUBound(Massiv, 1) 'просматриваем строки массива, начиная с той, значения которой храняться в TmpMas1 'для обратной сортировки поменять знак в следующей строке If Massiv(n, SortColumn) < TmpMas1(SortColumn) Then'если значение в массиве меньше, чем в TmpMas1 то меняем строки местами For j = LBound(Massiv, 2) ToUBound(Massiv, 2)
TmpMas1(j) = Massiv(n, j) 'сохраняем во временный массив найденные значения
Massiv(n, j) = Massiv(i, j) 'перезаписываем найденные значения значениями из i-той строки
Massiv(i, j) = TmpMas1(j) 'и присваиваем i-той строке массива найденные значения Next j EndIf Next n Next i
SortedRezult = Massiv Debug.Print"Массив отсортирован за: " & Timer - Start EndFunction
Может кому-то пригодится
Добрый день, а я использую вот такую функцию для сортирорвки
PublicFunction SortedRezult(Massiv AsVariant, SortColumn&) 'Massiv - двумерный массив 'SortColumn - колонка сортировки Dim Start!: Start = Timer Dim n&, j&, i& 'просто для цикла For...Next Dim TmpMas1() AsVariant: ReDim TmpMas1(LBound(Massiv, 2) ToUBound(Massiv, 2)) AsVariant OnErrorResumeNext For i = LBound(Massiv, 1) ToUBound(Massiv, 1) Step1'просматриваем все строки массива с верхней до нижней границы For j = LBound(Massiv, 2) ToUBound(Massiv, 2)
TmpMas1(j) = Massiv(i, j) 'заполняем временный массив Next j For n = i ToUBound(Massiv, 1) 'просматриваем строки массива, начиная с той, значения которой храняться в TmpMas1 'для обратной сортировки поменять знак в следующей строке If Massiv(n, SortColumn) < TmpMas1(SortColumn) Then'если значение в массиве меньше, чем в TmpMas1 то меняем строки местами For j = LBound(Massiv, 2) ToUBound(Massiv, 2)
TmpMas1(j) = Massiv(n, j) 'сохраняем во временный массив найденные значения
Massiv(n, j) = Massiv(i, j) 'перезаписываем найденные значения значениями из i-той строки
Massiv(i, j) = TmpMas1(j) 'и присваиваем i-той строке массива найденные значения Next j EndIf Next n Next i
SortedRezult = Massiv Debug.Print"Массив отсортирован за: " & Timer - Start EndFunction
Извиняюсь за вопрос, вы эту форумулу по перебору элементов 2мерного массива сами вывели или откуда-то из вычматов заимствовали?
Так как , так и не понял откуда взялась формула перебора элементов двумерного массива в коде krosav4ig сделал процедуру сортировки 2 мерного массива методом Хоара, таким образом: 1.Сначала двумерный неотсортированный массив записывается во временный одномерный массив 2.А затем этот временный одномерный массив сортируется стандартной сортировкой Хоара для одномерных массивов 3.Далее отсортированный Хоаром одномерный массив обратно перезаписывается в двумерный массив, который тоже получается отсортированным.
Причем, данный код работает не только с равнобедренными матрицами типа n ^ 2 , но и с матрицами типа n*m, где n<>=m
' Сортировка двумерных численных массивов методом Хоара
Sub sort() Dim i AsInteger, j AsInteger Dim wsh As Worksheet Dim n AsInteger, c AsInteger, m AsInteger, t AsInteger Dim v() AsLong, List() AsLong
Set wsh = ActiveWorkbook.Sheets("Лист2")
wsh.Cells.Clear ' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2
n = InputBox("введите количество строк двумерного массива", "массив", 3)
m = InputBox("введите количество столбцов двумерного массива", "массив", 3) If n > Int((2 ^ 15 - 1) ^ 0.5) Or m > Int((2 ^ 15 - 1) ^ 0.5) Then Err.Raise 6'максимальное значение integer = 2^15-1 ReDim v(1To n, 1To m) ' иннициация 2-мерного массива
Randomize 'инициализация генератора случайных чисел For i = 1To n: For j = 1To m
v(i, j) = Int(Rnd * 1000) ' заполнение 2-мерного массива рандомными числами Next j, i With wsh.Cells(1).Resize(i - 1, j - 1)
.Value = v ' выгрузка массива V на лист
' переносим значения двумерного массива V в одномерный временный массив List, чтобы потом применить к этому временному массиву стандартную процедуру Сортировки одномерных массивов HoarSort ReDim List(1To n * m) ' иннициация 1-мерного массива For i = 1To n For j = 1To m
t = t + 1
List(t) = v(i, j)
wsh.Cells(1).Offset(n + 1, t - 1) = t ' вывели индексы одномерного массива в строку с номером n+1 на Листе2 для наглядности
wsh.Cells(1).Offset(n + 2, t - 1) = List(t) ' вывели элементы массива List в строку с номером n+2 на Листе2 Next Next
HoarSort List, 1, t ' сортанули наш временный одномерный массив с помощью процедуры быстрой сортировки по Хоару HoarSort
.Resize(1, t).Offset(n + 3) = List() ' записываем отсортированные строки 1-мерного List массива в Лист2 с троку n+2 для наглядности
'Перезаписываем отсортированный 1-мерный массив List в 2-мерный массив V и выводим на Лист2
t = 0 For i = 1To n For j = 1To m
t = t + 1
v(i, j) = List(t) Next Next
.Resize(n, m).Offset(n + 5) = v ' записываем отсортированные строки 1-мерного List массива, которые мы поместили в старый двумерный массив V в Лист2 EndWith
EndSub
Sub HoarSort(ByRef List&(), ByVal min&, ByVal max&) Dim med AsLong Dim hi AsLong Dim lo AsLong Dim i AsLong, j AsInteger Dim temp AsLong
lo = min
hi = max
i = Int((lo + hi) / 2) ' берем точку деления массива ,как среднее арифметическое
med = List(i) ' записываем во временную переменную точку деления массива пополам по Хоару
Do DoWhile List(lo) > med 'для сортировки по возрастанию поменять знак > на <
lo = lo + 1 Loop DoWhile List(hi) < med 'для сортировки по возрастанию поменять знак < на >
hi = hi - 1 Loop If lo <= hi Then
Swap2 List(lo), List(hi)
lo = lo + 1: hi = hi - 1: j = j + 1
EndIf
LoopWhile lo <= hi If lo < max Then HoarSort List, lo, max If hi > min Then HoarSort List, min, hi EndSub 'Данная функция меняет местами элементы массива PrivateFunction Swap2(ByRef a&, ByRef b&) Dim c&: c = a: a = b: b = c EndFunction
Извиняюсь за вопрос, вы эту форумулу по перебору элементов 2мерного массива сами вывели или откуда-то из вычматов заимствовали?
Так как , так и не понял откуда взялась формула перебора элементов двумерного массива в коде krosav4ig сделал процедуру сортировки 2 мерного массива методом Хоара, таким образом: 1.Сначала двумерный неотсортированный массив записывается во временный одномерный массив 2.А затем этот временный одномерный массив сортируется стандартной сортировкой Хоара для одномерных массивов 3.Далее отсортированный Хоаром одномерный массив обратно перезаписывается в двумерный массив, который тоже получается отсортированным.
Причем, данный код работает не только с равнобедренными матрицами типа n ^ 2 , но и с матрицами типа n*m, где n<>=m
' Сортировка двумерных численных массивов методом Хоара
Sub sort() Dim i AsInteger, j AsInteger Dim wsh As Worksheet Dim n AsInteger, c AsInteger, m AsInteger, t AsInteger Dim v() AsLong, List() AsLong
Set wsh = ActiveWorkbook.Sheets("Лист2")
wsh.Cells.Clear ' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2
n = InputBox("введите количество строк двумерного массива", "массив", 3)
m = InputBox("введите количество столбцов двумерного массива", "массив", 3) If n > Int((2 ^ 15 - 1) ^ 0.5) Or m > Int((2 ^ 15 - 1) ^ 0.5) Then Err.Raise 6'максимальное значение integer = 2^15-1 ReDim v(1To n, 1To m) ' иннициация 2-мерного массива
Randomize 'инициализация генератора случайных чисел For i = 1To n: For j = 1To m
v(i, j) = Int(Rnd * 1000) ' заполнение 2-мерного массива рандомными числами Next j, i With wsh.Cells(1).Resize(i - 1, j - 1)
.Value = v ' выгрузка массива V на лист
' переносим значения двумерного массива V в одномерный временный массив List, чтобы потом применить к этому временному массиву стандартную процедуру Сортировки одномерных массивов HoarSort ReDim List(1To n * m) ' иннициация 1-мерного массива For i = 1To n For j = 1To m
t = t + 1
List(t) = v(i, j)
wsh.Cells(1).Offset(n + 1, t - 1) = t ' вывели индексы одномерного массива в строку с номером n+1 на Листе2 для наглядности
wsh.Cells(1).Offset(n + 2, t - 1) = List(t) ' вывели элементы массива List в строку с номером n+2 на Листе2 Next Next
HoarSort List, 1, t ' сортанули наш временный одномерный массив с помощью процедуры быстрой сортировки по Хоару HoarSort
.Resize(1, t).Offset(n + 3) = List() ' записываем отсортированные строки 1-мерного List массива в Лист2 с троку n+2 для наглядности
'Перезаписываем отсортированный 1-мерный массив List в 2-мерный массив V и выводим на Лист2
t = 0 For i = 1To n For j = 1To m
t = t + 1
v(i, j) = List(t) Next Next
.Resize(n, m).Offset(n + 5) = v ' записываем отсортированные строки 1-мерного List массива, которые мы поместили в старый двумерный массив V в Лист2 EndWith
EndSub
Sub HoarSort(ByRef List&(), ByVal min&, ByVal max&) Dim med AsLong Dim hi AsLong Dim lo AsLong Dim i AsLong, j AsInteger Dim temp AsLong
lo = min
hi = max
i = Int((lo + hi) / 2) ' берем точку деления массива ,как среднее арифметическое
med = List(i) ' записываем во временную переменную точку деления массива пополам по Хоару
Do DoWhile List(lo) > med 'для сортировки по возрастанию поменять знак > на <
lo = lo + 1 Loop DoWhile List(hi) < med 'для сортировки по возрастанию поменять знак < на >
hi = hi - 1 Loop If lo <= hi Then
Swap2 List(lo), List(hi)
lo = lo + 1: hi = hi - 1: j = j + 1
EndIf
LoopWhile lo <= hi If lo < max Then HoarSort List, lo, max If hi > min Then HoarSort List, min, hi EndSub 'Данная функция меняет местами элементы массива PrivateFunction Swap2(ByRef a&, ByRef b&) Dim c&: c = a: a = b: b = c EndFunction
Если интересно ускорение сортировки, то имеет смысл: - перед запуском сортера индексировать массив (создат одномерный массив лонгов) - сам сортер также (разумеется) переделать в сортер по индексам с добавлением в качестве параметра ссылки на индексный массив (Arr(ID(a), n) - вариант обращения к элементу массива по его индексу) - при свопинге менять местами только индексы, а не элементы сортируемого массива - по окончанию сортировки по полученному порядку индексов пересобрать исходный массив
Если интересно ускорение сортировки, то имеет смысл: - перед запуском сортера индексировать массив (создат одномерный массив лонгов) - сам сортер также (разумеется) переделать в сортер по индексам с добавлением в качестве параметра ссылки на индексный массив (Arr(ID(a), n) - вариант обращения к элементу массива по его индексу) - при свопинге менять местами только индексы, а не элементы сортируемого массива - по окончанию сортировки по полученному порядку индексов пересобрать исходный массивAnchoret