Сортировка листов в Excel

Автор: | 30.03.2015

В Excel имеется свой встроенный механизм сортировки по 3 параметрам одновременно, реализованный через функции листа. Сортировка обычно используется для упорядочивания данных по возрастанию или убывания на отдельном листе. Сортировка производится над списками. Отдельного алгоритма сортировки средствами VBA, известного в информатике, в Excel нет. Я имею в виду стандартную сортировку по методу “пузырька”,  вставок, на минимум и максимум. быструю сортировку и другие виды сортировок. Именно эти типы сортировок я обычно давал учащимся на уроках. Алгоритмы сортировок и программы пригодятся в Excel для  сортировки листов, сортировки элементов коллекций или данных для ListBox или ComboBox.

Предлагаю Вам сортировку листов из книги Джона Уокенбаха “Профессиональное программирование на VBA в Excel …” . Версий книг Джона Уокенбаха уже несколько, заточенных под соответствующую версию Офиса. Макрос можно улучшить, добавив возможность выбора сортировки по возрастанию или убывания. А пока я добавил лишь одну строку в программу сортировки и закомментировал её. Изменяя знак меньше на больше, можно изменять порядок сортировки.

Option Explicit

Sub SortSheets()
‘ Эта процедура сортирует листы в
‘ активной книге по возрастанию.
‘ Нажмите клавиши <Ctrl+Shift+S> для выполнения процедуры

Dim SheetNames() As String
Dim i As Long
Dim SheetCount As Long
Dim OldActive As Object

If ActiveWorkbook Is Nothing Then Exit Sub ‘ No active workbook
SheetCount = ActiveWorkbook.Sheets.Count

‘ Проверка структуры защищенной книги
If ActiveWorkbook.ProtectStructure Then
MsgBox ActiveWorkbook.Name & ” защищена.”, _
vbCritical, “Невозможно отсортировать листы.”
Exit Sub
End If

‘ Выполнение верификации пользователя
If MsgBox(“Отсортировать листы в активной книге?”, _
vbQuestion + vbYesNo) <> vbYes Then Exit Sub

‘ Отключние комбинации клавиш <Ctrl+Break>
Application.EnableCancelKey = xlDisabled

‘ Получение количества листов
SheetCount = ActiveWorkbook.Sheets.Count

‘ Изменение размерности массива
ReDim SheetNames(1 To SheetCount)

‘ Сохранение ссылки на активный лист
Set OldActive = ActiveSheet

‘ Заполнение массива названиями листов
For i = 1 To SheetCount
SheetNames(i) = ActiveWorkbook.Sheets(i).Name
Next i

‘ Сортировка массива по возрастанию
Call BubbleSort(SheetNames)

‘ Отключение обновления экрана
Application.ScreenUpdating = False

‘ Перемещение листов
For i = 1 To SheetCount
ActiveWorkbook.Sheets(SheetNames(i)).Move _
Before:=ActiveWorkbook.Sheets(i)
Next i

‘ Повторная активизация исходного активного листа
OldActive.Activate

End Sub
Sub BubbleSort(List() As String)
Dim First As Long, Last As Long
Dim i As Long, j As Long
Dim Temp As String
First = LBound(List)
Last = UBound(List)
For i = First To Last – 1
For j = i + 1 To Last
‘If UCase(List(i)) > UCase(List(j)) Then
If UCase(List(i)) < UCase(List(j)) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Next i
End Sub

Скачать книгу sheet sorter.xls Джона Уокенбаха, содержащую  макрос сортировки листов