Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сортировка двумерного массива по возрастанию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сортировка двумерного массива по возрастанию (Макросы/Sub)
Сортировка двумерного массива по возрастанию
t330 Дата: Воскресенье, 24.02.2019, 01:05 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

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

[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-мерного массива
    
Range(Cells(1, 1), Cells(i - 1, j)).Offset(n + 1) = V() ' записываем отсортированные строки 2-мерного массива в Лист2

End Sub

[/vba]
 
Ответить
СообщениеВсем добрый день.
Помогите пожалуйста понять, что нужно сделать в моем коде ниже, чтобы двумерный массив сортировался по возрастанию не в каждой строке отдельно(как сейчас), независимо от значений в других строках массива, а так , чтобы массив сортировался полностью , то есть чтобы Первый элемент массива был минимальным, а последний элемент в последней строке в последнем столбце был максимальным?

[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-мерного массива
    
Range(Cells(1, 1), Cells(i - 1, j)).Offset(n + 1) = V() ' записываем отсортированные строки 2-мерного массива в Лист2

End Sub

[/vba]

Автор - t330
Дата добавления - 24.02.2019 в 01:05
krosav4ig Дата: Воскресенье, 24.02.2019, 02:52 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте.
[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
[/vba]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Воскресенье, 24.02.2019, 04:31
 
Ответить
СообщениеЗдравствуйте.
[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
[/vba]

Автор - krosav4ig
Дата добавления - 24.02.2019 в 02:52
t330 Дата: Воскресенье, 24.02.2019, 03:19 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Решил вопрос полной сортироваки 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
    
Range(Cells(1, 1), Cells(i - 1, j - 1)).Offset(n + 1) = V() ' записываем отсортированные строки 2-мерного массива в Лист2

End Sub

[/vba]
 
Ответить
СообщениеРешил вопрос полной сортироваки 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
    
Range(Cells(1, 1), Cells(i - 1, j - 1)).Offset(n + 1) = V() ' записываем отсортированные строки 2-мерного массива в Лист2

End Sub

[/vba]

Автор - t330
Дата добавления - 24.02.2019 в 03:19
krosav4ig Дата: Воскресенье, 24.02.2019, 03:40 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 2346
Репутация: 989 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Исправил свой пост, написал фигню какую-то сгородил
до кучи, 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]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Воскресенье, 24.02.2019, 04:29
 
Ответить
СообщениеИсправил свой пост, написал фигню какую-то сгородил
до кучи, 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]

Автор - krosav4ig
Дата добавления - 24.02.2019 в 03:40
t330 Дата: Воскресенье, 24.02.2019, 19:44 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Спасибо за интересный код, работает.
ТОлько нужно исправить в предпоследнй строке выражение b=d на b=c

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


Сообщение отредактировал t330 - Понедельник, 25.02.2019, 15:50
 
Ответить
СообщениеСпасибо за интересный код, работает.
ТОлько нужно исправить в предпоследнй строке выражение b=d на b=c

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

Автор - t330
Дата добавления - 24.02.2019 в 19:44
t330 Дата: Понедельник, 25.02.2019, 05:17 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
  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

Извиняюсь за вопрос, вы эту форумулу по перебору элементов 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

Извиняюсь за вопрос, вы эту форумулу по перебору элементов 2мерного массива сами вывели или откуда-то из вычматов заимствовали?

Автор - t330
Дата добавления - 25.02.2019 в 05:17
boa Дата: Понедельник, 25.02.2019, 14:58 | Сообщение № 7
Группа: Друзья
Ранг: Ветеран
Сообщений: 549
Репутация: 167 ±
Замечаний: 0% ±

365
Добрый день, а я использую вот такую функцию для сортирорвки

Может кому-то пригодится


 
Ответить
СообщениеДобрый день, а я использую вот такую функцию для сортирорвки

Может кому-то пригодится

Автор - boa
Дата добавления - 25.02.2019 в 14:58
t330 Дата: Пятница, 01.03.2019, 21:28 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 0 ±
Замечаний: 20% ±

Excel 2016
Извиняюсь за вопрос, вы эту форумулу по перебору элементов 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

[/vba]
 
Ответить
Сообщение
Извиняюсь за вопрос, вы эту форумулу по перебору элементов 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

[/vba]

Автор - t330
Дата добавления - 01.03.2019 в 21:28
Anchoret Дата: Четверг, 14.03.2019, 15:00 | Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Если интересно ускорение сортировки, то имеет смысл:
- перед запуском сортера индексировать массив (создат одномерный массив лонгов)
- сам сортер также (разумеется) переделать в сортер по индексам с добавлением в качестве параметра ссылки на индексный массив (Arr(ID(a), n) - вариант обращения к элементу массива по его индексу)
- при свопинге менять местами только индексы, а не элементы сортируемого массива
- по окончанию сортировки по полученному порядку индексов пересобрать исходный массив
 
Ответить
СообщениеЕсли интересно ускорение сортировки, то имеет смысл:
- перед запуском сортера индексировать массив (создат одномерный массив лонгов)
- сам сортер также (разумеется) переделать в сортер по индексам с добавлением в качестве параметра ссылки на индексный массив (Arr(ID(a), n) - вариант обращения к элементу массива по его индексу)
- при свопинге менять местами только индексы, а не элементы сортируемого массива
- по окончанию сортировки по полученному порядку индексов пересобрать исходный массив

Автор - Anchoret
Дата добавления - 14.03.2019 в 15:00
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сортировка двумерного массива по возрастанию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!