Макрос для объединения одинаковых ячеек в таблице 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»-«Выполнить». Результат действия макроса отображен на рисунке:
В начале кода мы декларируем переменную для хранения показателей счетчика цикла. В цикле проверяем значения соседних ячеек, начиная с низа выделенного диапазона. Если ячейка содержит такое же значение значит она будет объединена.
Обратите внимание! Если перед выполнением макроса выделить более одного столбца, то в результате будут объединены одинаковые значения только в первом столбце. Чтобы расширить поле действия макроса следует немного изменить его код.
Как объединить все одинаковые ячейки в любой таблице
Немного изменим структуру исходной таблицы:
На этот раз нам необходимо объединить все ячейки с одинаковыми значениями в столбце «Штат» (B) в столбце «№» (A).
Если мы хотим, чтобы действия макроса распространялось на несколько выделенных столбцов, то делаем следующее. Сначала добавим новую переменную:
Далее добавим строку с кодом начала нового цикла, который будет проходить по другим столбцам выделенного диапазона:
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
Чтобы увидеть результат действия новой версии кода, выделяем всю таблицу и запускаем макрос:
Как видно на рисунке теперь макрос автоматически объединяет одинаковые значения сразу в двух столбцах.
В данном практическом примере мы напишем и пошагово разберем принцип действия VBA кода макроса для автоматического объединения повторяющихся ячеек в таблице.
Как объединить все повторяющиеся ячейки в строке
У нас иметься квартальный отчет, сформированный по отделам, как показано ниже на рисунке:
Сначала нам необходимо объединить все ячейки, которые содержат в своем значении одинаковый год. Решение данной задачи можно существенно упростить с помощью готового макроса.
Откройте редактор Visual Basic (ALT+F11):
Создайте новый модуль с помощью инструмента: «Insert»-«Module». А потом введите в него следующий VBA-код:
Sub MergeDoubles()
Dim i As Long
Application.DisplayAlerts = False
For i = Selection.Columns.Count To 2 Step -1
If Selection.Cells(1, i) = Selection.Cells(1, i - 1) Then
Range(Selection.Cells(1, i - 1), Selection.Cells(1, i)).Merge
End If
Next
Selection.HorizontalAlignment = xlHAlignCenter
Application.DisplayAlerts = True
End Sub
Теперь если нам нужно объединить одинаковые ячейки в строке по горизонтали, выделите диапазон ячеек B1:L1 и запустите макрос. А для этого выберите инструмент: «РАЗРАБОТЧИК»-«Код»-«Макросы»-«MergeDoubles»-«Выполнить». В результате должен получиться эффект такой же как на рисунке:
Так же мы еще воспользуемся объектом HorizontalAlignment, чтобы выровнять текст в объединенных ячейках по центру устанавливаем ему свойство xlHAlignCenter.
Обратите внимание на то, что наш макрос пока еще не умеет работать более чем с одной строкой. Сколько строк не выделяй он все равно объединяет повторяющиеся значения только в первой строке.
Как объединить все повторяющиеся ячейки одновременно
Если данный макрос должен уметь работать сразу с несколькими выделенными строками одновременно, тогда усовершенствуем его изменив и настроив код. В начале кода добавим декларацию для новой переменной j:
Далее нам необходимо создать новый цикл, который должен срабатывать еще до выполнения старого цикла. Так выглядит строка кода для нового цикла, которую следует добавить выше уже имеющегося цикла:
For j = 1 To Selection.Rows.Count
После инструкции конца первого цикла добавляем новую строку с инструкцией конца для второго:
Далее во всех экземплярах объекта Cells указываем в аргументе в место числа 1 переменную j. Например, Selection.Cells(i, j). Полная версия усовершенствованного кода макроса выглядит так:
Sub MergeDoubles()
Dim i As Long
Dim j As Long
Application.DisplayAlerts = False
For j = 1 To Selection.Rows.Count
For i = Selection.Columns.Count To 2 Step -1
If Selection.Cells(j, i) = Selection.Cells(j, i - 1) Then
Range(Selection.Cells(j, i - 1), Selection.Cells(j, i)).Merge
End If
Next
Next
Selection.HorizontalAlignment = xlHAlignCenter
Application.DisplayAlerts = True
End Sub
А теперь выделите диапазон B1:L12 и запустите макрос с уже новой версией кода:
Теперь, можно выделять любое количество строк и наш макрос будет во всех этих строках искать ячейки с одинаковым значением подряд, чтобы объединить их.
Объединить ячейки чтобы придать таблице читабельный вид очень часто существенно усложняется с увеличением объема данных. Так же весьма неблагодарным занятием является присвоение соответственных границ для ячеек. На помощь пользователям приходят макросы, благодаря которым все эти действия можно выполнить автоматически.
Автоматическое объединение большого количества ячеек по вертикали
Допустим мы имеем маркетинговый план внедрения нового информационного программного продукта:
Чтобы план было легче визуально анализировать лучше объединить ячейки этапов выполнения плана: A2:A4, B2:B4 и т.д. К сожалению, многократно объединять диапазоны с большим количеством строк вручную – это задание требует слишком много времени и сил. Кроме того, можно допустить много ошибок после очередного десятка выделения ячеек перед объединением. Рассмотрим каким способом можно существенно облегчить свой труд переложив большую часть работы на простую программу, написанную на языке VBA прямо в Excel. Для этого следует написать макрос, который безошибочно быстро и автоматически объединит ячейки диапазонов с разным количеством строк для каждого столбца.
- Сначала откройте редактор макросов: «РАЗРАБОТЧИК»-«Код»-«Visual Basic» (или просто нажмите ALT+F11).
- Откройте стандартный модуль выбрав инструмент в редакторе: «Insert»-«Module» и введите в него следующий код макроса для объединения ячеек:
Sub ObedenitVertikal()
Dim i As Long
Dim j As Long
Dim intext As String
Application.DisplayAlerts = False
For i = 1 To Selection.Columns.Count
intext = Selection.Cells(1, i)
For j = 2 To Selection.Rows.Count
intext = intext & Chr(10) & Selection.Cells(j, i)
Next
Selection.Columns(i).Merge
Selection.Cells(1, i) = intext
Next
Application.DisplayAlerts = True
End Sub
Пока что это еще не полная версия макроса поэтому перед тем как его проверить нам все еще вручную необходимо выделить первый диапазон A2:D4. После чего можно выполнить нашу первую версию макроса.
Запуск макроса для объединения ячеек
Выбираем инструмент: «РАЗРАБОТЧИК»-«Код»-«Макросы».
В появившемся диалоговом окне выделяем значение «ObedenitVertikal» и нажимаем на кнопку «Выполнить».
Потом снова вручную выделите новый диапазон A5:D9 и повторно выполните тот же макрос. Ячейки будут выделены как показано ниже на рисунке:
В начале кода определены 3 переменные: две из них выполняют функцию счетчика, а третья служит для временного хранения текстового содержания ячеек. Счетчик первой переменной в цикле проходит по очереди все столбцы выделенного диапазона ячеек. В каждом таком столбце в текстовую переменную записывается текст, который содержится в первой ячейке каждого выделенного столбца. Второй счетчик идет по строкам каждого столбца и дописывает в текстовую переменную текстовые значения из остальных ячеек каждого текущего столбца выделенного диапазона – сверху вниз. Тексты, взятые из отдельных ячеек разделяться символом обрыва строки.
Символ обрыва строки вставлен с помощью функции Chr(10). Каждый вводимый символ из клавиатуры имеет свой код ASCII. Если введем код 10 в качестве аргумента для функции Chr(), тогда она будет возвращать символ обрыва строки. Такой же код ASCII на клавиатуре вызывается клавишей Enter для обрыва строки во всех текстовых редакторах.
Внимание! Если ячейки выделенного диапазона будут содержать формулы, то после выполнения макроса эти формулы будут заменены на текст. В результате после объединения ячеек макросом, формулы могут быть утеряны.
Модернизация и настройка кода макроса для объединения ячеек
Если нам нужно изменить текст разделяющий отдельные строки символов содержащийся в целых ячейках, то можно вписать другой код символа, текст или несколько текстов соединенных символом амперсантом (&). Допустим мы хотим вставить между двумя символами разрыва строки текст, состоящий из пяти тире «-----». Тогда данную строку следует модифицировать следующим образом:
intext = intext & Chr(10) & “-----” & Chr(10) & Selection.Cells(j, i)
Если в объединенной ячейке мы хотим всегда вставлять только текст из первой ячейки в выделенном столбце (без текстов, записанных в остальных ячейках), тогда удалим или закомментируем переменную второго счетчика и часть кода второго цикла:
Если нам нужно чтобы выполнять макрос после выделения нескольких диапазонов (с удержанием клавиши CTRL), тогда можно добавить еще одну переменную, которая будет дополнять функцию счетчика:
Перед первым циклом добавим новую строку с кодом:
For k = 1 To Selection.Areas.Count
А после последнего цикла добавим строку конца нового цикла:
Соответственно добавим новый отступ, чтобы код был более читабельным. Кроме того, после всех изменений для объекта Selection добавим ссылку на диапазон:
Полная новая версия макроса для объедения ячеек выделенных нескольких диапазонов, выглядит так:
Sub ObedenitVertikal()
Dim i As Long
Dim j As Long
Dim k As Long
Dim intext As String
Application.DisplayAlerts = False
For k = 1 To Selection.Areas.Count
For i = 1 To Selection.Areas(k).Columns.Count
intext = Selection.Areas(k).Cells(1, i)
For j = 2 To Selection.Areas(k).Rows.Count
intext = intext & Chr(10) & Selection.Areas(k).Cells(j, i)
Next
Selection.Areas(k).Columns(i).Merge
Selection.Areas(k).Cells(1, i) = intext
Next
Next
Application.DisplayAlerts = True
End Sub
Тепер выделяем 2 диапазона подряд A2:D4, A5:D8, A с нажатой клавишей CTRL на клавиатуре:
В результате получаем идентичный вид таблицы с объединенными ячейками:
Если выполнить первую версию макроса (без всех этих изменений), для многократного выделения диапазонов с нажатой клавишей CTRL, то объединение строк по столбцам будет выполнено только для первого диапазона.
Про то, как можно быстро склеивать текст из нескольких ячеек в одну и, наоборот, разбирать длинную текстовую строку на составляющие я уже писал. Теперь же давайте рассмотрим близкую, но чуть более сложную задачу - как склеивать текст из нескольких ячеек при выполнении определенного заданного условия.
Допустим, что у нас имеется база данных по клиентам, где одному названию компании может соответствовать несколько разных email'ов ее сотрудников. Наша задача состоит в том, чтобы собрать все адреса по названиям компаний и сцепить их (через запятую или точку с запятой), чтобы сделать потом, например, почтовую рассылку по клиентам, т.е. получить на выходе что-то похожее на:
Другими словами, нам нужен инструмент, который будет склеивать (сцеплять) текст по условию - аналог функции СУММЕСЛИ (SUMIF) , но для текста.
Способ 0. Формулой
Не очень изящный, зато самый простой способ. Можно написать несложную формулу, которая будет проверять отличается ли компания в очередной строке от предыдущей. Если не отличается, то приклеиваем через запятую очередной адрес. Если отличается, то "сбрасываем" накопленное, начиная заново:
Минусы такого подхода очевидны: из всех ячеек полученного дополнительного столбца нам нужны только последние по каждой компании (желтые). Если список большой, то чтобы их быстро отобрать придется добавить еще один столбец, использующий функцию ДЛСТР (LEN) , проверяющий длину накопленных строк:
Теперь можно отфильтровать единички и скопировать нужные склейки адресов для дальнейшего использования.
Способ 1. Макрофункция склейки по одному условию
Если исходный список не отсортирован по компаниям, то приведенная выше простая формула не работает, но можно легко выкрутиться с помощью небольшой пользовательской функции на VBA. Откройте редактор Visual Basic нажатием на сочетание клавиш Alt+F11 или с помощью кнопки Visual Basic на вкладке Разработчик (Developer) . В открывшемся окне вставьте новый пустой модуль через меню Insert - Module и скопируйте туда текст нашей функции:
Если теперь вернуться в Microsoft Excel, то в списке функций (кнопка fx в строке формул или вкладка Формулы - Вставить функцию) можно будет найти нашу функцию MergeIf в категории Определенные пользователем (User Defined) . Аргументы у функции следующие:
Способ 2. Сцепить текст по неточному условию
Если заменить в 13-й строчке нашего макроса первый знак = на оператор приблизительного совпадения Like, то можно будет осуществлять склейку по неточному совпадению исходных данных с критерием отбора. Например, если название компании может быть записано в разных вариантах, то мы можем одной функцией проверить и собрать их все:
Поддерживаются стандартные спецсимволы подстановки:
По умолчанию оператор Like регистрочувствительный, т.е. понимает, например, "Орион" и "оРиОн" как разные компании. Чтобы не учитывать регистр можно добавить в самое начало модуля в редакторе Visual Basic строчку Option Compare Text, которая переключит Like в режим, когда он невосприимчив к регистру.
Таким образом можно составлять весьма сложные маски для проверки условий, например:
Способ 3. Макрофункция склейки текста по двум условиям
В работе может встретиться задача, когда сцеплять текст нужно больше, чем по одному условию. Например представим, что в нашей предыдущей таблице добавился еще один столбец с городом и склеивание нужно проводить не только для заданной компании, но еще и для заданного города. В этом случае нашу функцию придется немного модернизировать, добавив к ней проверку еще одного диапазона:
Применяться она будет совершенно аналогично - только аргументов теперь нужно указывать больше:
Способ 4. Группировка и склейка в Power Query
Решить проблему можно и без программирования на VBA, если использовать бесплатную надстройку Power Query. Для Excel 2010-2013 ее можно скачать здесь, а в Excel 2016 она уже встроена по умолчанию. Последовательность действий будет следующей:
Power Query не умеет работать с обычными таблицами, поэтому первым шагом превратим нашу таблицу в "умную". Для этого ее нужно выделить и нажать сочетание Ctrl + T или выбрать на вкладке Главная - Форматировать как таблицу (Home - Format as Table) . На появившейся затем вкладке Конструктор (Design) можно задать имя таблицы (я оставил стандартное Таблица1):
Теперь загрузим нашу таблицу в надстройку Power Query. Для этого на вкладке Данные (если у вас Excel 2016) или на вкладке Power Query (если у вас Excel 2010-2013) жмем Из таблицы (Data - From Table) :
В открывшемся окне редактора запросов выделяем щелчком по заголовку столбец Компания и сверху жмем кнопку Группировать (Group By) . Вводим имя нового столбца и тип операции в группировке - Все строки (All Rows) :
Жмем ОК и получаем для каждой компании мини-таблицу сгруппированных значений. Содержимое таблиц хорошо видно, если щелкать левой кнопкой мыши в белый фон ячеек (не в текст!) в получившемся столбце:
Теперь добавим еще один столбец, где с помощью функции склеим через запятую содержимое столбцов Адрес в каждой из мини-таблиц. Для этого на вкладке Добавить столбец жмем Пользовательский столбец (Add column - Custom column) и в появившемся окне вводим имя нового столбца и формулу сцепки на встроенном в Power Query языке М:
Обратите внимание, что все М-функции регистрочувствительные (в отличие от Excel). После нажатия на ОК получаем новый столбец со склееными адресами:
Осталось удалить ненужный уже столбец ТаблАдресов (правой кнопкой мыши по заголовку - Удалить столбец) и выгрузить результаты на лист, нажав на вкладке Главная - Закрыть и загрузить (Home - Close and load) :
Важный нюанс : в отличие от предыдущих способов (функций), таблицы из Power Query не обновляются автоматически. Если в будущем произойдут какие-либо изменения в исходных данных, то нужно будет щелкнуть правой кнопкой в любое место таблицы результатов и выбрать команду Обновить (Refresh) .
Подскажите, как реализовать следующее:
Имеется таблица. Необходимо по строкам объединить повторяющиеся (одинаковые) значения.
Во вложении файл с исходными данными и желаемым результатом. Причем объединять ячейки нужно прям в таблице "исходные данные".
Спасибо!
Макрос на объединение одинаковых ячеек не видит нули
здравствуйте . использую макрос для объединения одинаковых строк в первом столбце Sub q() ' '.
Объединение ячеек одного столбца при совпадении ячеек в другом
Здравствуйте, В таблице необходимо объединить все телефоны в одну ячейку, если совпадение по.
Объединение ячеек
Добрый день! Есть две колонки A и В с некоторым набором строк. Некоторые строки объединены.
Объединение ячеек
В столбце Идентификатор помещения есть некоторые значения. Этих значений будет около тысячи.Между.
Решение
Объединение ячеек по условию
Доброго всем дня! В таблице есть переменный критерий(сорт). Требуется объединить одинаковые.
Объединение ячеек в строках
Помогите пожалуйста, я только начал заниматься VBA. Мне нужно написать макрос в exelкоторый бы в.
Объединение ячеек с условием
Доброй день, не особо вникал в VBA, но на работе пригодилось, нужно сделать проверку на одинаковые.
Объединение и разобъединение ячеек
Добрый день друзья! Перерыл весь (думаю весь) интернет в поисках решения своей задачки. Удалось.
Объединение ячеек VBA
Здравствуйте, не могу запустить цикл по объединению ячеек как показано на изображении. На первом.
Объединение ячеек столбца в word
Открывается вордовский документ в котором есть таблица. Нужно объеденить 1,2,3 ячейку в 1 столбце.
Читайте также: