Всем добрый день. Помогите пожалуйста понять, что нужно сделать в моем коде ниже, чтобы двумерный массив сортировался по возрастанию не в каждой строке отдельно(как сейчас), независимо от значений в других строках массива, а так , чтобы массив сортировался полностью , то есть чтобы Первый элемент массива был минимальным, а последний элемент в последней строке в последнем столбце был максимальным?
[vba]
Код
Option Explicit Sub sort()
Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, l As Integer, c As Integer Dim V() As Long Dim r As Range, temp As Long
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2 n = InputBox("введите размер двумерного массива", "массив", 3) ReDim V(1 To n, 1 To n) ' иннициация 2-мерного массива
For i = 1 To n For j = 1 To 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 = 1 To n ' цикл для перебора строк 2-мерного массива, которые надо сортировать For i = 1 To n ' начало сортировки отдельной строки методом пузырька For j = 1 To 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 End If Next j Next i ' конец сортировки отдельной строки методом пузырька Next c ' приступаем к сортировке следующей строки 2-мерного массива
Всем добрый день. Помогите пожалуйста понять, что нужно сделать в моем коде ниже, чтобы двумерный массив сортировался по возрастанию не в каждой строке отдельно(как сейчас), независимо от значений в других строках массива, а так , чтобы массив сортировался полностью , то есть чтобы Первый элемент массива был минимальным, а последний элемент в последней строке в последнем столбце был максимальным?
[vba]
Код
Option Explicit Sub sort()
Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, l As Integer, c As Integer Dim V() As Long Dim r As Range, temp As Long
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2 n = InputBox("введите размер двумерного массива", "массив", 3) ReDim V(1 To n, 1 To n) ' иннициация 2-мерного массива
For i = 1 To n For j = 1 To 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 = 1 To n ' цикл для перебора строк 2-мерного массива, которые надо сортировать For i = 1 To n ' начало сортировки отдельной строки методом пузырька For j = 1 To 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 End If Next j Next i ' конец сортировки отдельной строки методом пузырька Next c ' приступаем к сортировке следующей строки 2-мерного массива
Sub sort() Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, c As Integer Dim V() As Long Dim b As Boolean
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(1 To n, 1 To n) ' иннициация 2-мерного массива Randomize 'инициализация генератора случайных чисел For i = 1 To n: For j = 1 To 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 = 0 To 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 End With End Sub Private Function Swap(ByRef a&, ByRef b&) If a > b Then: Dim c&: c = a: a = b: b = d End Function
[/vba]
Здравствуйте. [vba]
Код
Sub sort() Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, c As Integer Dim V() As Long Dim b As Boolean
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(1 To n, 1 To n) ' иннициация 2-мерного массива Randomize 'инициализация генератора случайных чисел For i = 1 To n: For j = 1 To 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 = 0 To 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 End With End Sub Private Function Swap(ByRef a&, ByRef b&) If a > b Then: Dim c&: c = a: a = b: b = d End Function
Решил вопрос полной сортироваки 2мерного массива аж 4мя вложенными циклами. Может есть какой-то более изящный и короткий метод?
[vba]
Код
Option Explicit Sub sort()
Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, l As Integer, fi As Integer, fj As Integer Dim V() As Long Dim r As Range, temp As Long
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2 n = InputBox("введите размер двумерного массива", "массив", 3) ReDim V(1 To n, 1 To n) ' иннициация 2-мерного массива
For i = 1 To n For j = 1 To 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 = 1 To n For j = 1 To n For fi = 1 To n For fj = 1 To n If V(i, j) > V(fi, fj) Then temp = V(fi, fj) V(fi, fj) = V(i, j) V(i, j) = temp End If Next fj Next fi Next j Next i
Решил вопрос полной сортироваки 2мерного массива аж 4мя вложенными циклами. Может есть какой-то более изящный и короткий метод?
[vba]
Код
Option Explicit Sub sort()
Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, l As Integer, fi As Integer, fj As Integer Dim V() As Long Dim r As Range, temp As Long
Set WSh = ActiveWorkbook.Sheets("Лист2")
' Заполняем массив рандомными числами и для наглядности записываем их в диапазон на Листе2 n = InputBox("введите размер двумерного массива", "массив", 3) ReDim V(1 To n, 1 To n) ' иннициация 2-мерного массива
For i = 1 To n For j = 1 To 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 = 1 To n For j = 1 To n For fi = 1 To n For fj = 1 To n If V(i, j) > V(fi, fj) Then temp = V(fi, fj) V(fi, fj) = V(i, j) V(i, j) = temp End If Next fj Next fi Next j Next i
Исправил свой пост, написал фигню какую-то сгородил до кучи, QuickSort [vba]
Код
Option Explicit Sub sort() Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, c As Integer Dim v() As Long Dim b As Boolean
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(1 To n, 1 To n) ' иннициация 2-мерного массива Randomize 'инициализация генератора случайных чисел For i = 1 To n: For j = 1 To 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 End With End Sub Sub Quicksort(ByRef values&(), ByVal min As Long, ByVal max As Long, n%)
Dim med_value As String Dim hi As Long Dim lo As Long Dim i As Long
' If the list has only 1 item, it's sorted. If min >= max Then Exit Sub
' 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. Do While values(hi \ n + 1, hi Mod n + 1) >= med_value hi = hi - 1 If hi <= lo Then Exit Do Loop
If hi <= lo Then ' The list is separated. values(lo \ n + 1, lo Mod n + 1) = med_value Exit Do End If
' 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 Do While values(lo \ n + 1, lo Mod n + 1) < med_value lo = lo + 1 If lo >= hi Then Exit Do Loop
If lo >= hi Then ' The list is separated. lo = hi values(hi \ n + 1, hi Mod n + 1) = med_value Exit Do End If
' 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
End Sub
[/vba]
Исправил свой пост, написал фигню какую-то сгородил до кучи, QuickSort [vba]
Код
Option Explicit Sub sort() Dim i As Integer, j As Integer Dim WSh As Worksheet Dim n As Integer, c As Integer Dim v() As Long Dim b As Boolean
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(1 To n, 1 To n) ' иннициация 2-мерного массива Randomize 'инициализация генератора случайных чисел For i = 1 To n: For j = 1 To 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 End With End Sub Sub Quicksort(ByRef values&(), ByVal min As Long, ByVal max As Long, n%)
Dim med_value As String Dim hi As Long Dim lo As Long Dim i As Long
' If the list has only 1 item, it's sorted. If min >= max Then Exit Sub
' 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. Do While values(hi \ n + 1, hi Mod n + 1) >= med_value hi = hi - 1 If hi <= lo Then Exit Do Loop
If hi <= lo Then ' The list is separated. values(lo \ n + 1, lo Mod n + 1) = med_value Exit Do End If
' 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 Do While values(lo \ n + 1, lo Mod n + 1) < med_value lo = lo + 1 If lo >= hi Then Exit Do Loop
If lo >= hi Then ' The list is separated. lo = hi values(hi \ n + 1, hi Mod n + 1) = med_value Exit Do End If
' 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
Добрый день, а я использую вот такую функцию для сортирорвки
[vba]
Код
Public Function SortedRezult(Massiv As Variant, SortColumn&) 'Massiv - двумерный массив 'SortColumn - колонка сортировки Dim Start!: Start = Timer Dim n&, j&, i& 'просто для цикла For...Next Dim TmpMas1() As Variant: ReDim TmpMas1(LBound(Massiv, 2) To UBound(Massiv, 2)) As Variant On Error Resume Next For i = LBound(Massiv, 1) To UBound(Massiv, 1) Step 1 'просматриваем все строки массива с верхней до нижней границы For j = LBound(Massiv, 2) To UBound(Massiv, 2) TmpMas1(j) = Massiv(i, j) 'заполняем временный массив Next j For n = i To UBound(Massiv, 1) 'просматриваем строки массива, начиная с той, значения которой храняться в TmpMas1 'для обратной сортировки поменять знак в следующей строке If Massiv(n, SortColumn) < TmpMas1(SortColumn) Then 'если значение в массиве меньше, чем в TmpMas1 то меняем строки местами For j = LBound(Massiv, 2) To UBound(Massiv, 2) TmpMas1(j) = Massiv(n, j) 'сохраняем во временный массив найденные значения Massiv(n, j) = Massiv(i, j) 'перезаписываем найденные значения значениями из i-той строки Massiv(i, j) = TmpMas1(j) 'и присваиваем i-той строке массива найденные значения Next j End If Next n Next i SortedRezult = Massiv Debug.Print "Массив отсортирован за: " & Timer - Start End Function
[/vba]
Может кому-то пригодится
Добрый день, а я использую вот такую функцию для сортирорвки
[vba]
Код
Public Function SortedRezult(Massiv As Variant, SortColumn&) 'Massiv - двумерный массив 'SortColumn - колонка сортировки Dim Start!: Start = Timer Dim n&, j&, i& 'просто для цикла For...Next Dim TmpMas1() As Variant: ReDim TmpMas1(LBound(Massiv, 2) To UBound(Massiv, 2)) As Variant On Error Resume Next For i = LBound(Massiv, 1) To UBound(Massiv, 1) Step 1 'просматриваем все строки массива с верхней до нижней границы For j = LBound(Massiv, 2) To UBound(Massiv, 2) TmpMas1(j) = Massiv(i, j) 'заполняем временный массив Next j For n = i To UBound(Massiv, 1) 'просматриваем строки массива, начиная с той, значения которой храняться в TmpMas1 'для обратной сортировки поменять знак в следующей строке If Massiv(n, SortColumn) < TmpMas1(SortColumn) Then 'если значение в массиве меньше, чем в TmpMas1 то меняем строки местами For j = LBound(Massiv, 2) To UBound(Massiv, 2) TmpMas1(j) = Massiv(n, j) 'сохраняем во временный массив найденные значения Massiv(n, j) = Massiv(i, j) 'перезаписываем найденные значения значениями из i-той строки Massiv(i, j) = TmpMas1(j) 'и присваиваем i-той строке массива найденные значения Next j End If Next n Next i SortedRezult = Massiv Debug.Print "Массив отсортирован за: " & Timer - Start End Function
Извиняюсь за вопрос, вы эту форумулу по перебору элементов 2мерного массива сами вывели или откуда-то из вычматов заимствовали?
Так как , так и не понял откуда взялась формула перебора элементов двумерного массива в коде krosav4ig сделал процедуру сортировки 2 мерного массива методом Хоара, таким образом: 1.Сначала двумерный неотсортированный массив записывается во временный одномерный массив 2.А затем этот временный одномерный массив сортируется стандартной сортировкой Хоара для одномерных массивов 3.Далее отсортированный Хоаром одномерный массив обратно перезаписывается в двумерный массив, который тоже получается отсортированным.
Причем, данный код работает не только с равнобедренными матрицами типа n ^ 2 , но и с матрицами типа n*m, где n<>=m
[vba]
Код
' Сортировка двумерных численных массивов методом Хоара
Sub sort() Dim i As Integer, j As Integer Dim wsh As Worksheet Dim n As Integer, c As Integer, m As Integer, t As Integer Dim v() As Long, List() As Long
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(1 To n, 1 To m) ' иннициация 2-мерного массива Randomize 'инициализация генератора случайных чисел For i = 1 To n: For j = 1 To 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(1 To n * m) ' иннициация 1-мерного массива For i = 1 To n For j = 1 To 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 = 1 To n For j = 1 To m t = t + 1 v(i, j) = List(t) Next Next .Resize(n, m).Offset(n + 5) = v ' записываем отсортированные строки 1-мерного List массива, которые мы поместили в старый двумерный массив V в Лист2 End With
End Sub
Sub HoarSort(ByRef List&(), ByVal min&, ByVal max&) Dim med As Long Dim hi As Long Dim lo As Long Dim i As Long, j As Integer Dim temp As Long lo = min hi = max i = Int((lo + hi) / 2) ' берем точку деления массива ,как среднее арифметическое med = List(i) ' записываем во временную переменную точку деления массива пополам по Хоару
Do Do While List(lo) > med 'для сортировки по возрастанию поменять знак > на < lo = lo + 1 Loop Do While 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
End If
Loop While lo <= hi If lo < max Then HoarSort List, lo, max If hi > min Then HoarSort List, min, hi End Sub 'Данная функция меняет местами элементы массива Private Function Swap2(ByRef a&, ByRef b&) Dim c&: c = a: a = b: b = c End Function
Извиняюсь за вопрос, вы эту форумулу по перебору элементов 2мерного массива сами вывели или откуда-то из вычматов заимствовали?
Так как , так и не понял откуда взялась формула перебора элементов двумерного массива в коде krosav4ig сделал процедуру сортировки 2 мерного массива методом Хоара, таким образом: 1.Сначала двумерный неотсортированный массив записывается во временный одномерный массив 2.А затем этот временный одномерный массив сортируется стандартной сортировкой Хоара для одномерных массивов 3.Далее отсортированный Хоаром одномерный массив обратно перезаписывается в двумерный массив, который тоже получается отсортированным.
Причем, данный код работает не только с равнобедренными матрицами типа n ^ 2 , но и с матрицами типа n*m, где n<>=m
[vba]
Код
' Сортировка двумерных численных массивов методом Хоара
Sub sort() Dim i As Integer, j As Integer Dim wsh As Worksheet Dim n As Integer, c As Integer, m As Integer, t As Integer Dim v() As Long, List() As Long
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(1 To n, 1 To m) ' иннициация 2-мерного массива Randomize 'инициализация генератора случайных чисел For i = 1 To n: For j = 1 To 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(1 To n * m) ' иннициация 1-мерного массива For i = 1 To n For j = 1 To 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 = 1 To n For j = 1 To m t = t + 1 v(i, j) = List(t) Next Next .Resize(n, m).Offset(n + 5) = v ' записываем отсортированные строки 1-мерного List массива, которые мы поместили в старый двумерный массив V в Лист2 End With
End Sub
Sub HoarSort(ByRef List&(), ByVal min&, ByVal max&) Dim med As Long Dim hi As Long Dim lo As Long Dim i As Long, j As Integer Dim temp As Long lo = min hi = max i = Int((lo + hi) / 2) ' берем точку деления массива ,как среднее арифметическое med = List(i) ' записываем во временную переменную точку деления массива пополам по Хоару
Do Do While List(lo) > med 'для сортировки по возрастанию поменять знак > на < lo = lo + 1 Loop Do While 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
End If
Loop While lo <= hi If lo < max Then HoarSort List, lo, max If hi > min Then HoarSort List, min, hi End Sub 'Данная функция меняет местами элементы массива Private Function Swap2(ByRef a&, ByRef b&) Dim c&: c = a: a = b: b = c End Function
Если интересно ускорение сортировки, то имеет смысл: - перед запуском сортера индексировать массив (создат одномерный массив лонгов) - сам сортер также (разумеется) переделать в сортер по индексам с добавлением в качестве параметра ссылки на индексный массив (Arr(ID(a), n) - вариант обращения к элементу массива по его индексу) - при свопинге менять местами только индексы, а не элементы сортируемого массива - по окончанию сортировки по полученному порядку индексов пересобрать исходный массив
Если интересно ускорение сортировки, то имеет смысл: - перед запуском сортера индексировать массив (создат одномерный массив лонгов) - сам сортер также (разумеется) переделать в сортер по индексам с добавлением в качестве параметра ссылки на индексный массив (Arr(ID(a), n) - вариант обращения к элементу массива по его индексу) - при свопинге менять местами только индексы, а не элементы сортируемого массива - по окончанию сортировки по полученному порядку индексов пересобрать исходный массивAnchoret