Как сделать сортировку vba

Добавил пользователь Владимир З.
Обновлено: 05.10.2024

Помогите пожалуйста добрые люди!!))))Как в VBA в Excel отсортировать массив чисел в ячейках по убыванию. Какими операторами пользоваться?? И если сложно напишите примерную программу.. Век благодарен буду. ) ПЛИЗ. )))

Надо просто мышкой выделить диапазон, затем включить запись макроса и произвести сортироку (меню Данные - Сортировка).

Я вот так сделал и вот что получилось
Сортируем диапазон A1:A20

Sub Макрос1()
Range("A1:A20").Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub

'по убыванию
Order1:=xlDescending

'по возрастанию
Order1:=xlAscending

хм, если нужно сортировать данные в ячейках, то лучше воспользоваться встроенной Сортировкой. Если вы хотите сортировать массивы данных (не на листе), то вот пару примеров

Сортировка массивов (не помню на каком форуме взял)

Sub MyBubbleSort(arr, Optional k As Byte = 0) ' Сортировка простым обменом ' ort by [E]lementary [E]xchange
Dim i As Long, j As Long, t As Variant
On Error Resume Next
For i = UBound(arr) To LBound(arr) + 1 Step -1
For j = LBound(arr) To i - 1
If CSng(Left(arr(j), Len(arr(j)) - k)) > CSng(Left(arr(j + 1), Len(arr(j + 1)) - k)) Then
t = arr(j)
arr(j) = arr(j + 1)
arr(j + 1) = t
End If
Next
Next
End Sub

Sub MyQuickSort(arr, Optional First As Long = -1, Optional Last As Long = -1) ' Быстрая сортировка, [Q]uick ort
Dim i As Long, j As Long, MidEl As Variant, t As Variant
On Error Resume Next
First = IIf(First = -1, LBound(arr), First)
Last = IIf(Last = -1, UBound(arr), Last)
i = First
j = Last
MidEl = arr((First + Last) \ 2)
Do While i MidEl Then
j = j - 1
Else
t = arr(i)
arr(i) = arr(j)
arr(j) = t
i = i + 1
j = j - 1
End If
End If
Loop
If First

В настоящей заметке описана разработка утилиты VBA для Excel. Показан процесс анализа задачи и последующего ее решения. Пример рассмотрен в расчете на начинающих.[1] Цель — разработать утилиту, которая изменяет порядок следования листов рабочей книги, сортируя их названия по алфавиту (без кода VBA это сделать невозможно). Если вы часто создаете книги с большим количеством листов, то знаете, что иногда сложно найти интересующий вас лист. Если же их упорядочить по названиям, то любой рабочий лист найти будет значительно проще.

Рис. 1. Метод Move объекта Sheets

Начнем с перечисления требований к приложению. В процессе разработки вы будете обращаться к этому перечню для проверки правильности выполнения действий.

Часто самой сложной частью проекта является определение того, с чего же начать. В данном случае начнем с перечисления особенностей Excel, которые могут повлиять на соблюдение требований к проекту.

Вот предварительный план, описывающий общие задачи:

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

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

Откройте новую рабочую книгу, содержащую три рабочих листа. Включите функцию записи макросов и перетащите третий рабочий лист на место первого. Остановите запись макроса. Изучите код:

Найдите в справочной системе слово Move (это метод, перемещающий лист в рабочей книге на новое место). Для этого, например, находясь в окне VBE, нажмите F2 (рис. 1; см. также справку в Интернете). Данный метод имеет один аргумент, определяющий будущее положение листа.

Вам также необходимо узнать количество листов в активной рабочей книге. Активизируем окно отладки (Immediate) в VBE (нажав Ctrl+G) и введем такой оператор:

VBA вернула значение 3 (рис. 2).

Рис. 2. Использование окна отладки в VBE для тестирования оператора

Теперь введем в окне отладки (Immediate) следующий оператор:

В результате будет получено название первого листа — ЛистЗ.

Конструкция For Each-Next используется для циклического просмотра всех членов коллекции (см., например, Основы программирования на VBA, раздел Управление объектами и коллекциями):

Sub Test()
For Each Sht In ActiveWorkbook.Sheets
MsgBox Sht.Name
Next Sht
End Sub

Что касается сортировки, справочная система подскажет, что метод Sort относится к объекту Range. Поэтому одним из решений задачи могло быть перенесение названия листов в диапазон ячеек и сортировка этого диапазона. Однако такая задача слишком сложна. Возможно, целесообразнее сформировать из названий листов массив строк, а затем отсортировать этот массив с использованием кода VBA.

Однако прежде следует задать первоначальные настройки:

Создайте пустую рабочую книгу с пятью рабочими листами: названия — Лист1, Лист2, ЛистЗ, Лист4 и Лист5.
Разместите листы произвольно, чтобы они следовали не по порядку.
Сохраните рабочую книгу как Test.xlsm.
Перейдите в VBE (меню Разработчик –> Visual Basic) и выберите проект Personal.xlsb в окне Project (Проект). Если Personal.xlsb не отображается в окне Project, значит вы никогда не использовали личную книгу макросов. Excel создаст для вас эту книгу, когда вы запишете макрос (любой) и определите, что он должен сохраняться в личной книге макросов (подробнее см. Создание личной книги макросов).
Добавьте новый модуль VBA (используя команду Inserts –>Module).
Создайте пустую процедуру с названием SortSheets (рис. 3).
Перейдите в Excel. Выберите команду Разработчик –> Код –> Макросы для отображения диалогового окна Макрос.
В диалоговом окне Макрос выберите процедуру SortSheets и щелкните на кнопке Параметры. В открывшемся окне Параметры макроса выберите Ctrl+Shift+S.

Рис. 3. Пустая процедура в модуле, находящемся в персональной книге макросов

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

Начинаем писать код процедуры

Вначале необходимо поместить названия листов в массив строк. Так как пока неизвестно, сколько листов содержит активная рабочая книга, для объявления массива используем оператор Dim с пустыми скобками. Помните, что затем нужно применить оператор ReDim и изменить размерность массива на требуемое число элементов (подробнее см. Основы программирования на VBA, раздел Массивы). В цикл добавим функцию MsgBox, чтобы убедиться, что названия листов на самом деле вводятся в массив.

Sub SortSheets()
' Сортировка листов в активной рабочей книге
Dim SheetNames() as String
Dim i as Long
Dim SheetCount as Long
SheetCount = ActiveWorkbook.Sheets.Count
ReDim SheetNames(1 To SheetCount)
For i = 1 To SheetCount
SheetNames(i) = ActiveWorkbook.Sheets(i).Name
MsgBox SheetNames(i)
Next i
End Sub

Этот прием не столь навязчив по сравнению с использованием операторов MsgBox. Не забудьте только удалить оператор по завершении тестирования.

Рис. 4. Использование метода Print объекта Debug в целях тестирования. Разместите курсор внутри текста процедуры Sub SortSheets(), откройте окно Immediate (Ctrl+G), нажмите Run. В окне Immediate отразятся номера листов книги; чтобы увеличить изображение кликните на нем правой кнопкой мыши и выберите Открыть картинку в новой вкладке

Пока процедура SortSheets всего лишь создает массив названий листов в соответствии с порядком их следования в активной рабочей книге. Теперь нужно отсортировать значения в массиве SheetNames и изменить порядок следования листов в книге согласно отсортированному массиву.

Создание процедуры сортировки

Можно вставить программу сортировки в процедуру SortSheets, но лучше написать общую процедуру сортировки, которую можно будет использовать и в других проектах (сортировка массивов — довольно популярная операция).

Существует несколько способов сортировки массивов. Мы выбрали пузырьковый метод (хотя это не очень быстрый прием, но его легко запрограммировать). В данном конкретном приложении высокая скорость выполнения операций не так уж важна. В пузырьковом методе используется вложенный цикл For-Next, в котором оценивается каждый элемент массива. Если элемент массива больше, чем следующий, то эти два элемента меняются местами. Такое сравнение повторяется для каждой пары элементов (т.е. n – 1 раз).

Sub BubbleSort(List() As String)
' Сортировка массива List по возрастанию
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 List(i) > List(j) Then
Temp = List(j)
List (j) = List(i)
List(i) = Temp
End If
Next j
Next i
End Sub

Эта процедура имеет один аргумент: одномерный массив с названием List. Массив, который передается в процедуру, может быть любой длины. Для присвоения нижней и верхней границ массива переменным First и Last использовались функции Lbound и UBound соответственно.

Ниже приведен код для тестирования процедуры BubbleSort:

Sub SortTester()
Dim x(1 To 5) As String
Dim i As Long
x(1) = " собака "
x(2) = " кот "
x(3) = " слон "
x(4) = " трубкозуб "
x(5) = " птица "
Call BubbleSort(x)
For i = 1 To 5
Debug.Print i, x(i)
Next i
End Sub

Процедура SortTester создает массив из пяти строк, передает его процедуре BubbleSort и отображает отсортированный массив в окне отладки Immediate. После того как код выполнил свое предназначение, он был удален.

Убедившись в том, что код работает надежно, я изменил процедуру SortSheets путем добавления вызова в процедуру BubbleSort, передачи массива SheetNames в качестве аргумента. Начиная с этого момента, модуль приобретает следующий вид.

По окончании работы процедуры SortSheets образуется массив, состоящий из отсортированных названий листов активной рабочей книги. Чтобы проверить это, можно отобразить содержимое массива в окне отладки, добавив в конец процедуры перед оператором End Sub такой код:

For i = 1 То SheetCount
Debug.Print SheetNames(i)
Next i

Напишем цикл For-Next, который просматривает каждый лист и перемещает его в соответствующее место, указанное в массиве SheetNames.

Например, в первой итерации цикла счетчик i = 1. Первый элемент массива SheetNames – Лист1. Следовательно, выражение для метода Move в цикле будет таким:

Вторая итерация цикла:

В конец процедуры SortSheets добавим новый код:

Теперь необходимо собрать весь код. Объявим все переменные, используемые в процедурах, и добавим несколько комментариев, а также пустых строк, чтобы программу можно было легче прочесть. В результате процедура SortSheets будет приведена к следующему виду:

Sub SortSheets ()
' Эта процедура сортирует листы
' активной рабочей книги по возрастанию.
' Нажмите клавиши для выполнения
Dim SheetNames() As String
Dim SheetCount As Long
Dim i As Long

' Определение количества листов и массива ReDim
SheetCount = ActiveWorkbook.Sheets.Count
ReDim SheetNames(1 To SheetCount)
SheetNames(i) = ActiveWorkbook.Sheets(i).Name

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

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

Дополнительное тестирование

Наверное, вы считаете, что работа окончена. Однако тот факт, что процедура работает с рабочей книгой Test.xlsm, не означает, что она будет работать со всеми рабочими книгами. Чтобы проверить программу, загрузим несколько других рабочих книг и вновь запустим программу. Скоро вы убедитесь в том, что приложение неидеально (если быть точным, оно далеко от идеала). Были обнаружены следующие проблемы:

Устранение проблем

Проблема 2. Можно использовать функцию UCase для сравнения названия листов в верхнем регистре. В процедуре BubbleSort место строки If List(i) > List(j) Then вставьте строку If UCase(List(i)) > UCase(List(j)) Then. Проблему регистра можно решить иначе: добавьте в начало модуля оператор: Option Compare Text. В этом случае VBA выполняет сравнение строк на основе нечувствительных к регистру правил сортировки. Другими словами, А считается тем же, что и а.

On Error Resume Next
SheetCount = ActiveWorkbook.Sheets.Count
If Err <> 0 Then Exit Sub ' нет активной рабочей книги

Можно и не использовать оператор On Error Resume Next. Альтернатива – поместить следующий оператор в верхнюю часть процедуры SortSheets:

If ActiveWorkbook Is Nothing Then Exit Sub

Проблема 4. Обычно для защиты структуры рабочей книги имеется серьезная причина. Мы не будем снимать защиту; программа должна отображать предупреждение, чтобы пользователь снял защиту и снова выполнил макрос. Проверку защищенной структуры книги выполнить легко — свойство ProtectStructure объекта WorkBook возвращает True, если книга защищена. Поэтому добавим в проект следующий код:

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

Проблема 5. Для повторной активизации листа после завершения сортировки я написал код, который сопоставляет исходный лист с объектной переменной OldActiveSheet, а также активизирует этот лист после завершения процедуры. Ниже показан оператор, который инициализирует переменную.

Set OldActive = ActiveSheet

А следующий оператор активизирует рабочий лист, который был изначально активным:

Будьте внимательны, когда отключаете прерывание макроса, выполняемое с помощью клавиш Ctrl+Break. Если программа попадет в бесконечный цикл, выйти из него вы не сможете. Лучше использовать этот оператор, когда все работает идеально.

Проблема 7. Для предотвращения проблемы, возникающей из-за случайной сортировки листов, перед отключением клавиш Ctrl+Break в процедуру был добавлен следующий оператор:

If MsgBox( " Сортировать листы в активной рабочей книге? " , _
vbQuestion + vbYesNo) <> vbYes Then Exit Sub

Рис. 6. Окно подтверждения необходимости сортировки листов

Финальный код процедуры можно найти в модуле VBA приложенного Excel-файла.

Доступность

Макрос SortSheets сохранен в личной книге макросов, поэтому он всегда доступен при запуске Excel. На этом этапе макрос может выполняться при выборе названия макроса в диалоговом окне Макрос. Это окно можно отобразить, пройдя по меню Вид –> Макросы –> Макросы, или нажав Alt+F8. Можно сразу запустить макрос нажав Ctrl+Shift+S. Команду вызова макроса можно также добавить на ленту. Для этого:

Щелкните правой кнопкой мыши на ленте и в контекстном меню выберите команду Настройка ленты.
На вкладке Настройка ленты диалогового окна Параметры Excel в списке Выбрать команды выберите категорию Макросы.
Щелкните на значке XLSB!SortSheets.
Используйте элементы управления в правом окне для создания новой вкладки и группы ленты (вы не сможете добавить команду в существующую группу.)

Я создал группу Мои макросы во вкладке Вид и переименовал новый, добавленный в эту группу элемент, на Сортировка листов (рис. 7).

Рис. 7. Добавление новой команды на ленту

1 комментарий для “Сортировка листов книги Excel с помощью процедуры VBA”

Добрый день.
Можно придумать маленьки макрос, который бы просто сортировал, всю таблицу, по примеру кнопки на панели?
Т.е. - есть огромная таблица, нужно ее постоянно сортировать по 8му столбцу и по 10му.

Т.е. сначала столбец № 8, потом столбец №10

Пробовал по этому примеру, ничего не получилось

Т.е. сначала столбец № 8, потом столбец №10

Пробовал по этому примеру, ничего не получилось wwizard

Т.е. сначала столбец № 8, потом столбец №10

Пробовал по этому примеру, ничего не получилось Автор - wwizard
Дата добавления - 10.01.2017 в 13:04

Я ищу подходящую реализацию сортировки для массивов в VBA. Рекомендуется использовать Quicksort. Или любой другой алгоритм сортировки, кроме пузырька или слияния, будет достаточным.

Обратите внимание, что это работает только с одномерными (так называемыми "нормальными"?) Массивами. (Там рабочая многомерный arraye QuickSort здесь.)

Большое спасибо за это! Я использовал сортировку вставкой в наборе данных 2500 записей, и для правильной сортировки потребуется около 22 секунд. Теперь он делает это за секунду, это чудо! ;)

Эффект этой функции, по-видимому, всегда заключается в перемещении первого элемента из источника в последнюю позицию в месте назначения и в порядке сортировки остальной части массива.

Я преобразовал алгоритм быстрой быстрой сортировки в VBA, если кто-то еще этого захочет.

Я оптимизировал его для работы в массиве Int/Longs, но его нужно просто преобразовать в тот, который работает с произвольными сопоставимыми элементами.

Кстати, это были комментарии к алгоритму: автор Джеймс Гослинг и Кевин А. Смит расширили с помощью TriMedian и InsertionSort Дениса Аренса, со всеми советами от Роберта Седжвика, он использует TriMedian и InsertionSort для списков короче 4. Это универсальная версия алгоритма быстрой сортировки CAR Hoare. Это будет обрабатывать массивы, которые уже отсортированы, и массивы с дублирующимися ключами.

Объяснение на немецком языке, но код является проверенной на месте реализацией:

Вызывается следующим образом:

в любом случае это byref, потому что byval не позволяет изменять + сохранять значения полей. Если в передаваемом аргументе вам абсолютно необходим байвал, используйте вместо строки вариант без скобок ().

Естественное число (строки) Быстрая сортировка

Просто купите тему. Обычно, если вы сортируете строки с номерами, вы получите что-то вроде этого:

Но вы действительно хотите, чтобы он распознавал числовые значения и сортировался как

Вот как это сделать.

Я украл Quick Sort из Интернета давным-давно, не уверен, где сейчас.
Я перевел функцию CompareNaturalNum, которая была первоначально написана на C из Интернета.
Отличие от других Q-Sorts: я не меняю значения, если BottomTemp = TopTemp

Естественное число Быстрая сортировка

Сравнение натуральных чисел (используется в быстрой сортировке)

isDigit (используется в CompareNaturalNum)

Я отправил некоторый код в ответ на связанный с ним вопрос в StackOverflow:

Образцы кода в этом потоке включают:

Массив векторных массивов Quicksort;
Многостолбцовый массив QuickSort;
A BubbleSort.

Оптимизированная оптимизация QuickSort оптимизирована: я просто сделал базовую сплит-рекурсию, но пример кода выше имеет функцию "gating", которая сокращает избыточные сравнения дублированных значений. С другой стороны, я кодирую для Excel, а там немного больше, чем защитное кодирование - будьте осторожны, вам понадобится, если ваш массив содержит пагубный вариант Empty(), который сломает ваше время. Wend сравнения операторов и захватить ваш код в бесконечном цикле.

Обратите внимание, что алгоритмы quicksort algorthms - и любой рекурсивный алгоритм - могут заполнять стек и разбивать Excel. Если ваш массив имеет менее 1024 членов, я бы использовал рудиментарный BubbleSort.

Читайте также: