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