Макрос для объединения одинаковых ячеек в таблице Excel
В данном примере напишем код макроса, который сможет автоматически найти и объединить все одинаковые ячейки в таблице Excel любой сложности.
Как объединить одинаковые ячейки в столбце используя макрос
Имеется отчет продаж в сети магазинов по целой стране. Нам нужно сделать таблицу данного отчета более читабельной. Для этого следует красиво сформатировать первый столбец, в котором содержаться названия штатов:
Мы хотим объединить все ячейки с одинаковыми значениями в столбце «Штат» (A). Это можно реализовать с помощью ручного выделения отдельных групп одинаковых значений и объединения их ячеек, воспользовавшись инструментом: «ГЛАВНАЯ»-«Выравнивание»-«Объединить и поместить в центре». Но если таблица содержит тысячи таких групп, да еще с разным количеством повторяющихся ячеек, тогда рационально написать макрос. Он сам быстро и автоматически выполнит всю работу за Вас.
Откройте редактор Visual Basic (ALT+F11):
И создайте новый модуль с помощью инструмента: «Insert»-«Module». А потом запишите в него VBA-код макроса:
Sub JoinDoubles()
Dim i As Long
Application.DisplayAlerts = False
For i = Selection.Rows.Count To 2 Step -1
If Selection.Cells(i, 1) = Selection.Cells(i - 1, 1) Then
Range(Selection.Cells(i - 1, 1), Selection.Cells(i, 1)).Merge
End If
Next
Selection.VerticalAlignment = xlVAlignCenter
Application.DisplayAlerts = True
End Sub
Теперь если нам необходимо объединить ячейки с одинаковыми значениями, то выделите диапазон A1:A18 и запустите макрос выбрав инструмент: «РАЗРАБОТЧИК»-«Код»-«Макросы»-«JoinDoubles»-«Выполнить». Результат действия макроса отображен на рисунке:
В начале кода мы декларируем переменную для хранения показателей счетчика цикла. В цикле проверяем значения соседних ячеек, начиная с низа выделенного диапазона. Если ячейка содержит такое же значение значит она будет объединена.
Дополнительно в начале кода макроса устанавливаем свойство «False» для объекта «DisplayAlerts», чтобы предотвратить появления предупреждающего сообщение о попытке объединить непустые ячейки в программе Excel. В конце выполнения кода макроса обратно возвращаем свойство «True» для объекта «DisplayAlerts».
Обратите внимание! Если перед выполнением макроса выделить более одного столбца, то в результате будут объединены одинаковые значения только в первом столбце. Чтобы расширить поле действия макроса следует немного изменить его код.
Как объединить все одинаковые ячейки в любой таблице
Немного изменим структуру исходной таблицы:
На этот раз нам необходимо объединить все ячейки с одинаковыми значениями в столбце «Штат» (B) в столбце «№» (A).
Если мы хотим, чтобы действия макроса распространялось на несколько выделенных столбцов, то делаем следующее. Сначала добавим новую переменную:
Dim j As Long
Далее добавим строку с кодом начала нового цикла, который будет проходить по другим столбцам выделенного диапазона:
For j = 1 To Selection.Columns.Count
После конца, ранее созданного (внутреннего) цикла добавляем инструкцию Next для конца нового (внешнего) цикла . И соответственно сделаем код более читабельным с помощью отступов табуляции. Кроме того, для всех экземпляров объекта Cells во втором аргументе, вместо числа 1 введем переменную j (например, Selection.Cells(i, j)). Новая версия измененного кода макроса выглядит следующим образом:
Sub JoinDoubles()
Dim i As Long
Dim j As Long
Application.DisplayAlerts = False
For j = 1 To Selection.Columns.Count
For i = Selection.Rows.Count To 2 Step -1
If Selection.Cells(i - 1, j) = Selection.Cells(i, j) Then
Range(Selection.Cells(i - 1, j), Selection.Cells(i, j)).Merge
End If
Next
Next
Selection.VerticalAlignment = xlVAlignCenter
Application.DisplayAlerts = True
End Sub
Чтобы увидеть результат действия новой версии кода, выделяем всю таблицу и запускаем макрос:
Читайте также: как объединить одинаковые ячейки в строках таблицы.
Как видно на рисунке теперь макрос автоматически объединяет одинаковые значения сразу в двух столбцах.