Статистика
Просмотры материалов : 155125Сортировка пузырьком |
Автор: Александр Хохлов |
05.02.2011 16:57 |
Cортировка диапазона значений пузырьком или методом простых обменов. Постановка задачиИмеется исходный диапазон - столбец A. Требуется осуществить его сортировку пузырьком по возрастанию и результат записать в столбец B. Действие 1. Алгоритм без флага.Представленная ниже функция SortBubbleArray() возвращает отсортированный по возрастанию массив. Алготитм сортировки пузырьком прост для понимания и реализации, но эффективен лишь для обработки небольших массивов. Public Function SortBubbleArray(A As Variant) As Variant Dim n, i, j As Byte Dim temp As Variant n = UBound(A, 1) For i = 1 To n - 1 For j = n - 1 To i Step -1 If A(j) > A(j + 1) Then temp = A(j) A(j) = A(j + 1) A(j + 1) = temp End If Next j Next i SortBubbleArray = A End Function Действие 2. Алгоритм с флагом.Немного улучшенная версия того же алгоритма - вариант с "флагом". Флаг - переменная, которая позволит избежать "пустых" проходов по массиву при поиске неверно стоящих элементов. Public Function SortBubbleFlagArray(A As Variant) As Variant Dim n, i As Byte Dim temp As Variant Dim Flg As Boolean n = UBound(A, 1) i = 0 Do i = i + 1 'сброс флага Flg = False For j = n - 1 To i Step -1 If A(j) > A(j + 1) Then temp = A(j) A(j) = A(j + 1) A(j + 1) = temp 'была перестановка Flg = True End If Next j 'выход, если перестановки отсутствуют Loop Until Flg = False SortBubbleFlagArray = A End Function Действие 3. Проверка работоспособности.Воспользуемся уже готовой функцией Случайная сортировка диапазона быстро работы с диапазонами и заполним исходный массив значениями с листа через нее. Public Function SortBubbleRange(fromRange, toRange As Range) Dim A As Variant Dim Ub As Byte Ub = fromRange.Rows.Count ReDim A(1 To Ub) As Variant For i = 1 To Ub A(i) = fromRange.Rows(i) Next i B = SortBubbleFlagArray(A) For i = 1 To Ub toRange.Rows(i) = B(i) Next i End Function Дальше вызов с указанием исходного-конечного диапазонов. Public Sub ПроверкаРаботы() Application.ScreenUpdating = False SortBubbleRange [a1:a10], [b1:b10] End Sub |