Случайная сортировка диапазона быстро
Автор: Александр Хохлов   
02.02.2011 10:46

Алгоритм позволит избежать "пустых" итераций цикла. Статья является логическим продолжением предыдущей.

Постановка задачи.

Требуется разработать более быстрый чем Случайная сортировка диапазона медленно алгоритм случайной сортировки строк исходного диапазона. Полученную случайную последовательность строк записать в новый диапазон. Исходный диапазон остается без изменений. Решение оформить в виде функции на VBA.

Действие 1. Алгоритм случайной сортировки линейного массива.

Сперва разработаем алгоритм, который позволит получать массив B, содержащий неповторяющиеся элементы случайно выбранные из A.

Основные моменты алгоритма:

  • Каждый раз при обращении к A работать только с новыми элементами;
  • Использованные элементы из A будем замещать другими - ни разу не использованными, взятыми из конца массива.
Public Function SortRndArray(A As Variant) As Variant
  'B - массив-результат
  Dim B As Variant
  'случайный индекс элемента массива
  Dim MyRndValue As Byte
  'Max_i - максимальное количество элементов 
  Max_i = UBound(A, 1)
  ReDim B(LBound(A, 1) To UBound(A, 1)) As Variant
  'заполнение выходного массива B
  'в произвольном порядке выбирая их из A
  For i = LBound(A, 1) To UBound(A, 1)
    'определение номера элемента из A
    MyRndValue = Int((Max_i * Rnd) + 1)
    'занесение этого элемента в выходной массив
    B(i) = A(MyRndValue)
    'замещение выбранного элемента из A последним элементом из A
    A(MyRndValue) = A(Max_i)
    'понижение верхней границы массива
    'т.о. "уменьшаем" размер массива на один элемент
    Max_i = Max_i - 1
  Next i
  'возвращаем массив значений B
  SortRndArray = B
End Function

Действие 2. Функция обработки диапазона значений.

Опишем функцию, в качестве параметров которой будут указываться исходный диапазон значений и выходной случайный диапазон, сформированный на основе исходного.

Public Function SortRndRange(fromRange, toRange As Range)
  Dim A As Variant
  Dim Ub As Byte
  'число элементов входящего диапазона
  Ub = fromRange.Rows.Count
  'переопределение исходного массива
  ReDim A(1 To Ub) As Variant
  'заполнение исходного массива A строками исходного диапазона
  For i = 1 To Ub
    A(i) = fromRange.Rows(i)
  Next i
  'вызов функции случайной сортировки SortRndArray()
  B = SortRndArray(A)
  'заполнение выходного диапазона значениями выходного массива B
  For i = 1 To Ub
   toRange.Rows(i) = B(i)
  Next i
End Function

Действие 3. Проверка работоспособности.

Вызываем, полученную функцию.

Public Sub ПроверкаРаботы()
  Application.ScreenUpdating = False
  SortRndRange [a1:a5], [b1:b5]
End Sub

Ставим кнопку на лист, "прикручиваем" к ней макрос ПроверкаРаботы и наблюдаем результат.

 

Добавить комментарий

Защитный код
Обновить