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


Чтобы увидеть результат действия новой версии кода, выделяем всю таблицу и запускаем макрос:

Читайте также: как объединить одинаковые ячейки в строках таблицы.

Как видно на рисунке теперь макрос автоматически объединяет одинаковые значения сразу в двух столбцах.

уважаемые!вечер добрый!

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

Например, есть 2 столбца
Значения в столбце 1 марка машины:
    А
1 Ауди
2 БМВ
3 Лексус
4 Тойота
5 Митсубиси
6 Ауди

Значения в столбце 2 — модель марки машины
   А                      В
1 Ауди               Q7
2 БМВ                x5
3 Лексус            RC
4 Тойота            Corolla
5 Митсубиси     Outlander
6 Ауди                TT

нужен макрос, чтобы при поиске одинаковых значений, он объединял в данном случае две строки (1 и 6) и по столбцу В формировались напротив этого значения две строки (1 — Q7, 2 — ТТ)

Вот так:
   А                      В
1 Ауди               Q7
                         TT
2 БМВ                x5
3 Лексус            RC
4 Тойота            Corolla
5 Митсубиси     Outlander

спасибо за помощь!!

Как сложить и удалить дубли в Excel.

​Смотрите также​​vladFo​TheArk​​ употреблять… ;)​.Subtotal 3, xlSum,​анна​ нужно запомнить, т.к.​Вложенные друг в друга​Этот способ является, по​Next​ горизонтали, выделите диапазон​ ссылкой столбец листа​
​ C стоят фамилии,​ фамилий в столбце​ есть дубль, у​ Выбирать фильтром нужные​
​Когда мы делали консолидацию​
​Рассмотрим,​, а Вам обязательно​: никак не сделать?​​2 KukLP: ошибку​​ Array(10)​миша​​ его придется использовать​
​ две функции ЕСЛИОШИБКА​ сути, логическим продолжением​Далее во всех экземплярах​ ячеек B1:L1 и​ $A. Если значения​ имена и отчества.​ А. В столбце​ ячеек с уникальными​ дубли. Как сделать​ на другом листе,​как сложить и удалить​ макросом? Сводная не​ только ручками перебирать?​
​ НЕ подтверждаю -​For Each a​витя​ потом еще раз​ реализуют вывод сначала​ предыдущего. Если списки​ объекта Cells указываем​ запустите макрос. А​ в соседних ячейках​ Чтобы сравнить сразу​ B установили формулу.​ данными написать слово​​ сводную таблицу, читайте​
​ то в диалоговом​ дубли в Excel​ подойдет?​Karataev​
​ XL-2010 SP1, все​ In .Columns(2).SpecialCells(2).Areas​витя​ при импорте второй​ уникальных из списка-1,​ не очень большого​ в аргументе в​ для этого выберите​ столбца $A равные​
​ по трем столбцам,​=ЕСЛИ(СЧЁТЕСЛИ(A$5:A5;A5)>1;»+»;»-«) Если в​ «Нет».​ в статье «Сводные​ окне консолидации в​
​. Как выделить дубли​wild_pig​
​: Можно использовать макрос.​ идет по хотелке.​If a.Count >​
​витя​ таблицы. Объединить две​ а потом из​ размера и заранее​ место числа 1​
​ инструмент: «РАЗРАБОТЧИК»-«Код»-«Макросы»-«MergeDoubles»-«Выполнить». В​ между собой тогда​
​ нужно соединить данные​ столбце В стоит​В столбце А​ таблицы Excel».​
​ строке «создавать связи​ в Excel, читайте​: так цена разная​ Макрос находится внутри​-65201-​ 1 Then​коля​ таблицы в дальнейшем​ списка-2 друг за​ известно предельное количество​ переменную j. Например,​ результате должен получиться​ формула возвращает значения​ трех столбцов в​ «+», значит такую​ устанавливаем фильтр. Как​Но мы сделаем​​ с исходными данными»​ в статье «Как​ у одинаковых наименований​ прикрепленного файла и​Z​Set a =​саша​
​ получится только если​
​ другом.​ элементов в них​ Selection.Cells(i, j). Полная​
​ эффект такой же​ ЛОЖЬ и форматирование​ одной ячейке. В​ фамилию уже написали.​ установить и работать​ проще и быстрее.​ поставили галочку. Теперь,​ выделить повторяющиеся значения​Manyasha​
​ запускается кнопкой из​: Скрин — левый​ a.Offset(, -1)​саша​ заголовки их столбцов​Обратите внимание, что это​ (например, не больше​ версия усовершенствованного кода​
​ как на рисунке:​ границе не применяется.​ ячейке D15 пишем​
​Третий способ.​ с фильтром, смотрите​ Выделяем таблицу, нажимаем​
​ если в столбце​ в Excel» тут.​:​ D1.​
​ верхний угол первого​For i =​саша​ совпадают.​ формула массива, т.е.​ 10), то можно​ макроса выглядит так:​В начале кода мы​ Но если верхнее​​ формулу, используя функцию​Посчитать количество одинаковых значений​ в статье «Фильтр​
​ сочетание клавиш Ctrl​ В изменятся цифры,​ Как удалить повторяющиеся​wild_pig​sv2014​
​ листа после макроса.​ 4 To 0​Казанский​Разворачиваем выпадающий список в​ после набора ее​
​ объединить две таблицы​Sub MergeDoubles()​ декларируем переменную, которая​
​ значение неравно (оператор​
​ «СЦЕПИТЬ» в Excel.​Excel.​ в Excel». В​ + T (английская​ то и в​ значения, смотрите в​, не вижу…тыкнете, пожалуйста,​:​
​ Прикрепленные файлы post_304936.jpg​ Step -1​:​ левом верхнем углу​ нужно ввести в​ в одну прямыми​Dim i As​ играет роль счетчика​ <>) нижнему значению​ =СЦЕПИТЬ(A15;» «;B15;» «;C15)​
​Нам нужно не​ ячейке B2 пишем​

​ на любой раскладке).​ этой таблице данные​ статье «Как удалить​ носом в такие​TheArk​

excel-office.ru

Как найти повторяющиеся значения в Excel.

​ (97.97 КБ)​​a.Offset(, i).MergeCells =​kamilat​ ​Закрыть и загрузить​​ ячейку не обычным​​ ссылками, добавить справа​ Long​ в цикле. С​​ тогда формула возвращает​​Про функцию «СЦЕПИТЬ»​ только выделить повторы,​​ слово «Нет».​
​ Получилась такая сводная​ пересчитаются автоматически. Проверяем​ дубли в Excel».​ строчки )​, добрый вечер,попробуйте макрос​burzuy​ True​, Сводная таблица.​и выбираем​ Enter, а сочетанием​ столбец с единичками​Dim j As​ помощью этого же​ значение ИСТИНА и​ читайте в статье​ но и вести​Нажимаем два раза левой​
​ таблица с фильтрами.​ – изменим цифру​Итак, нам нужно​vladFo​ test или test1​: пардон выкладываю с​​Next​kamilat​
​Закрыть и загрузить в…​ клавиш Ctrl+Shift+Enter и​ и построить по​ Long​ цикла мы проверяем​ применяется форматирования нижней​ «Функция «СЦЕПИТЬ» в​ их подсчет, написать​ мышкой на зеленый​ Внизу столбца В​ 12 в ячейке​ перед удалением дублей,​: Manyasha, не подойдет​ в столбце D​ поддержкой макроса​End If​: файл посмотрите пожалуста​
​ (Close&Load to…)​
​ затем скопировать (протянуть)​ получившейся таблице сводную:​ ​Application.DisplayAlerts = False​
​ значения всех соседних​ границы целой строки​ Excel».​ в ячейке их​ квадратик в правом​ установили автосумму.​ В2 основной таблицы​ их сложить. Рассмотрим​
​ — мне потом​ и E​burzuy​Next​ )))​:​ вниз на нижестоящие​Как известно, сводная​
​For j =​ ячеек в выделенном​ (так как в​Копируем формулу по​ количество.​ нижнем углу ячейки​Выберем фильтром дубли 1.​ на цифру 2.​ несколько способов.​
​ надо сделать импорт​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub test()​: хахаха если в​End With​kamilat​В следующем диалоговом окне​ ячейки с запасом.​ таблица игнорирует повторы,​
​ 1 To Selection.Rows.Count​ диапазоне справа на​ смешанной ссылке номер​ столбцу. Теперь выделяем​В ячейке G5​ (на картинке обведен​​ Получилось так.​ Получилось так.​Первый способ.​
​ csv на сайт​Dim z(), i&,​ таблице в ячейке​Range(«A2»).CurrentRegion.RemoveSubtotal​: Или Удалить дубликаты,​​ (оно может выглядеть​В английской версии Excel​ поэтому на выходе​For i =​ лево. Если ячейка​ строки не есть​
​ дубли любым способом.​
​ пишем такую формулу.​ красным цветом). Слово​ ​Как написать данные одновременно​
​Как работать с таблицей​Самый простой способ​ …​ j&, m&​
​ А1 нет значения​Application.DisplayAlerts = -1​
​ при условии что​​ немного по-другому -​ эта формула выглядит​ мы получим объединенный​ Selection.Columns.Count To 2​ содержит такое же​
​ абсолютным, а является​ Как посчитать в​ =ЕСЛИ(СЧЁТЕСЛИ(A$5:A$10;A5)>1;СЧЁТЕСЛИ(A$5:A5;A5);1) Копируем по​ скопируется вниз по​ в нескольких ячейках,​ консолидации, как объединить​
​ – это использовать​wild_pig​z = Range(«A1:C»​ ​ есть, то макрос​
​End Sub​ в таблице действительно​ не пугайтесь) выбираем​ как:​ список без дубликатов.​ Step -1​ значение, как и​ относительным адресом).​ Excel рабочие дни,​ столбцу. Получился счетчик​ столбцу до последней​ смотрите в статье​
​ несколько таблиц в​ функцию​: Чуть что сразу​ & Range(«A» &​
​ работает не верно.​
​burzuy​ ​ только один столбец​
​Только создать подключение (Only​=IFERROR(IFERROR(INDEX(Список1, MATCH(0, COUNTIF($E$1:E1, Список1),​ Вспомогательный столбец с​If Selection.Cells(j, i)​ соседняя, тогда они​Полезный совет! Если нужно​
​ прибавить к дате​ повторов.​ заполненной ячейки таблицы.​ «Как заполнить ячейки​ одну консолидацией, читайте​
​«Консолидация» в Excel​ потыкать, а поговорить?​ Cells.Rows.Count).End(xlUp).Row).Value​
​если есть значение​: спасибо!!! то что​Действительно Сводной таблицей,​ create connection)​ 0)), INDEX(Список2, MATCH(0,​
​ 1 нужен только​ = Selection.Cells(j, i​ объединяться. В начале​ разграничить данные не​ дни, т.д., смотрите​Изменим данные в столбце​Теперь в столбце​ в Excel одновременно».​
​ в статье «Как​
​. У нас такая​Действительно, я ошибся.​ ​With CreateObject(«scripting.dictionary»)​
​ Есть, то все​ надо, только одна​ но вроде как​:​ COUNTIF($E$1:E1, Список2), 0))),​ потому, что Excel​ — 1) Then​ выполнения макроса отключаем​
​ по первому столбцу​ в статье «Как​ А для проверки.​ A отфильтруем данные​Рассмотрим,​ объединить таблицы в​ таблица​200?’200px’:»+(this.scrollHeight+5)+’px’);»>Sub uuu()​​For i =​ отлично….​ маленькая проблемка.​
​ она у Вас​
​Повторяем всю процедуру (пункты​ «»)​ умеет строить сводные​Range(Selection.Cells(j, i -​
​ предупреждающее сообщение, которое​ таблицы, по любому​ посчитать рабочие дни​ Получилось так.​ – «Фильтр по​как найти повторяющиеся значения​ Excel».​.​Dim a(), b()​
​ 1 To UBound(z)​
​как это можно​этот макрос безосновательно​ ​ и так сводная​
​ 2-6) для второго​Минус у такого подхода​ по таблицам, содержащим,​ 1), Selection.Cells(j, i)).Merge​ по умолчанию возникает​​ другому, тогда соответственно​ в Excel».​Ещё один способ подсчета​ цвету ячейки». Можно​ в​Второй способ.​Нам нужно сложить все​Dim i&, j&,​If .exists(z(i, 1))​ поправить.​ объединяет ячейки также​ таблица или что?в​
​ списка. При переименовании​ в том, что​ по крайней мере,​End If​
​ при попытке объединить​ отсортируйте и просто​В приходных накладных или​ дублей описан в​ по цвету шрифта,​Excel​Сложить все дубли​ числа в столбце​ rw&​ = False Then​

excel-office.ru

Как объединить ячейки с одинаковым значением в Excel

​Z​ в первых двух​ таблице как показала​ заголовка столбца важно​ формулы массива ощутимо​ два столбца.​Next​ непустые ячейки в​ укажите адрес столбца.​ прайсах очень часто​ статье «Как удалить​ зависит от того,​,​

Как выделить одинаковые ячейки группами

​ с помощью формул.​ В по каждому​

​Dim el​m = m​: Все, как заказывали​ строках. а это​ в примере больше​ использовать то же​ замедляют работу с​При изменении исходных списков​Next​ программе Excel. Для​ Например, разграничим по​

​ повторяются некоторые значения​ повторяющиеся значения в​ как выделены дубли​как выделить одинаковые значения​ Таблица та же.​

1. ​ дублю из столбца​’———————​ + 1: .Item(z(i,​ — XL-2010 SP1​ в данном примере​
2. ​ столбцов, при сводн,таблице​ имя (Люди), что​ файлом, если в​
3. ​ новые данные по​Selection.HorizontalAlignment = xlHAlignCenter​ этого мы вызываем​ повторяющимся датам, а​ ячеек в разных​

​ Excel».​ в таблице.​ словами, знакамипосчитать количество​

​Принцип такой. Создаем​ А – отдельно​Application.ScreenUpdating = False​ 1)) = m:​ — хоккей! И​ не надо. сам​ серовно нужно объединить​

​ и в предыдущем​

​ исходных таблицах большое​ прямым ссылкам попадут​Application.DisplayAlerts = True​ объект «DisplayAlerts» и​ не по поставщикам.​ позициях. Если отсортировать​Как посчитать данные​В таблице остались две​ одинаковых значений​ дополнительный столбец, в​ все ячейки с​With ActiveSheet​ For j =​ Макрос1, и макрос​ не разберусь​ ячейки в первом​ запросе.​ (несколько сотен и​ в объединенную таблицу,​End Sub​ просто меняем его​ Для этого сначала​ эти значения не​ в ячейках с​

​ строки с дублями.​, узнаем​ ячейках которого будем​ цифрой 1, отдельно​a = .UsedRange.Value​ 1 To UBound(z,​ www? даже из​Z​ столбце​В окне Excel на​ более) количество элементов.​ но сводную придется​А теперь выделите диапазон​ свойство на значение​ сортируем данные по​ всегда удобно их​

​ дублями, а, затем,​ В верхней ячейке​

exceltable.com

Макрос для объединения повторяющихся ячеек в таблице Excel

​формулу для поиска одинаковых​ писать название дубля,​ все ячейки с​.UsedRange.EntireRow.Delete​ 2): z(m, j)​ других книг. Ищите​: Вариант — сводная,​

Как объединить все повторяющиеся ячейки в строке

​ну вот сами​ вкладке​Если в ваших исходных​ обновить уже вручную​

​ B1:L12 и запустите​ «False». В конце​ датам, а потом​ визуально анализировать. Например,​ удалить их, смотрите​ отфильтрованного столбца B​ значений в Excel​ который нужно сложить.​

​ цифрой 2, т.д.​End With​

​ = z(i, j):​ бяку у себя…​ а если XL-2010,​ тоже сделали сводн​Данные (Data)​

​ списках большое количество​
​ (правой кнопкой мыши​ макрос с уже​
​ кода не забудем​
​ используем условное форматирование​ названия поставщиков могут​ в статье «Как​
​ пишем слово «Да».​, т.д.​ Мы будем писать​
​ Мы не знаем,​With CreateObject("Scripting.Dictionary")​
​ Next​
​ :)​
​ то тем более...​
​ таб, ну теперь​
​или на вкладке​


​ элементов, например, по​ -​ новой версией кода:​ поменять значение в​ немного изменив формулу:​ быть очень похожими​ сложить и удалить​ Копируем по столбцу.​В Excel можно​ дубли в ячейках​ сколько и какие​

​For i =​Else​-77529-​ ;)​ нужно же украсить​Power Query​ несколько сотен или​Обновить​Читайте также: как объединить​ это же свойство​ =$C2<>$C3​ и какие данные​ ячейки с дублями​Возвращаем фильтром все строки​ не только выделять​ С2, С3, С4,​ у нас дубли​ 1 To UBound(a)​z(.Item(z(i, 1)), 2)​burzuy​-98041-​ нашу таблицу чтобы​выбираем​ тысяч, то вместо​). Если не нужен​ повторяющиеся ячейки в​ на «True», чтобы​Теперь список сгруппирован по​ к ним относятся​ в Excel» здесь.​ в таблице. Получилось​ и удалять дублирующие​ С5.​ в большой таблице.​

​If a(i, 1)​ = z(.Item(z(i, 1)),​: спасибо всем кто​KuklP​ перед началством показать,​Получить данные — Объединить​

​ медленной формулы массива​ пересчет «на лету»,​ столбце.​ снова включить действе​ одинаковым датам.​ легко спутать.​Четвертый способ.​ так.​ данные, но и​А в следующем​

​На новом листе​

Как объединить все повторяющиеся ячейки одновременно

​ <> «» Then​ UBound(z, 2) -​ откликнулся…​: У кого нибудь​ пустые строки есть​ запросы — Добавить​ лучше использовать принципиально​ то лучше воспользоваться​Теперь, можно выделять любое​

​ объекта «DisplayAlerts», как​

​В данном практическом примере​Допустим мы имеем список​Формула для поиска одинаковых​Мы подсветили ячейки со​ работать с ними​ столбце напишем формулу,​ делаем активной ячейку.​If .Exists(a(i, 1))​ 1) & «,»​

​Вроде называется сводная таблица​ еще объединяет в​

​ они не дають​ (Get Data -​ другой подход, а​ другими вариантами.​

​ количество строк и​

​ и должно быть​ мы напишем и​ поставщиков:​ значений в​ словом «Да» условным​ – посчитать дубли​ которая будет искать​ Мы, в нашем​

​ Then​
​ & z(i, UBound(z,​Пример​
​ первых двух строках?​ форматировать ячейки​
​ Merge Queries -​
​ именно - инструменты​Можно решить проблему формулами.​
​ наш макрос будет​ по умолчанию в​ пошагово разберем принцип​
​Перед тем как найти​Excel.​ форматированием. Вместо слов,​
​ перед удалением, обозначить​ дублирующие данные в​
​ примере, сделаем активной​
​b = .Item(a(i,​
​ 2) - 1)​
​БЫЛО:​
​ См. пример от​
​кажеться я не​


​ Append)​ надстройки Power Query.​ В этом случае​ во всех этих​

​ программе Excel.​ действия VBA кода​ повторяющиеся ячейки в​

​Нам нужно выделить​ можно поставить числа.​ дубли словами, числами,​ первом столбце и​ ячейку Е2 на​ 1))​ & «,» &​Иванова 3​

exceltable.com

Слияние двух списков без дубликатов

​ 05.02.2012, 04:33.​ могу ясно выразиться​:​ Эта надстройка по​ пересчет и обновление​ строках искать ячейки​Так же мы еще​ макроса для автоматического​ Excel, отсортируем поставщиков​ дубли формулой в​ Получится так.​ знаками, найти повторяющиеся​ складывать цифры по​

​ этом же листе.​b(15) = b(15)​ z(i, UBound(z, 2))​Иванова 5​burzuy​ извините, но я​

Способ 1. Удаление дубликатов

​В появившемся диалоговом окне​ умолчанию встроена в​ результатов будет происходить​ с одинаковым значением​ воспользуемся объектом HorizontalAlignment,​ объединения повторяющихся ячеек​ по их идентификатору.​​ условном форматировании. Выделяем​​Этот способ подходит, если​​ строки, состоящие из​ дублям из второго​​ На закладке «Данные»​

​ & «, «​End If​Петров 1​: сводная в данном​ хочу узнать какие​ выбираем наши запросы​ Excel 2016. Если​

Способ 1а. Сводная таблица

​ автоматически и мгновенно,​ подряд, чтобы объединить​ чтобы выровнять текст​ в таблице.​ Переходим в ячейку​ ячейки. Вызываем диалоговое​ данные в столбце​ нескольких ячеек, т.д.​ столбца.​ в разделе «Работа​ & a(i, 15)​Next​Петров 4​ случае не то.​ варианты есть чтоб​

​ из выпадающих списков:​ у вас Excel​ сразу после изменений​ их.​ в объединенных ячейках​У нас иметься квартальный​ A2 и выбираем​ окно условного форматирования.​ A не меняются.​ Как выделить цветом​В ячейке D2​ с данными» нажимаем​

​.Item(a(i, 1)) =​Range(«D1»).Resize(.Count, UBound(z, 2)​НАДО:​ надо чтобы четко​ объединить повторяющихся ячейки​В итоге получим новый​ 2010 или 2013,​ в исходных списках.​​Классическая ситуация: у вас​​ по центру устанавливаем​ отчет, сформированный по​ на закладке «ДАННЫЕ»​ Выбираем функцию «Использовать​

Способ 2. Формула массива

​ Или, после изменения,​ одинаковые значения в​ пишем такую формулу.​ на кнопку функции​ b​ — 1).Value =​Иванова 8​ было видно, что​burzuy​ запрос, где два​​ то ее можно​​ Для удобства и​​ есть два списка,​​ ему свойство xlHAlignCenter.​​ отделам, как показано​​ в разделе «Сортировка​​ формулу для определения​ повторить процедуру с​​ Excel условным форматированием,​

​ =СУММЕСЛИ(A2:A9;C2;B2:B9)​ «Консолидация». Выйдет диалоговое​Else​

​ z​Петров 5​ объединенные ячейки связанны​: Помогите пожалуйста! Нужен​ списка будут соединены​ отдельно скачать и​ краткости давайте дадим​ которые надо слить​Обратите внимание на то,​ ниже на рисунке:​ и фильтр» инструмент​

​ форматируемых ячеек».​

• ​ обозначением дублей.​ читайте в статье​В ячейку D3​ окно.​ReDim b(1 To​End With​
  
• ​Andrey kalashnikov​ с группой необъединеных,​ фрагмент макроса.​ друг под другом.​
• ​ установить (бесплатно).​ нашим спискам имена​ в один. Причем​ что наш макрос​Сначала нам необходимо объединить​ «Сортировка от А​В строке «Форматировать​

​Второй способ.​ «Условное форматирование в​ пишем такую формулу.​Заполнили его так:​ UBound(a, 2))​End Sub​: Выслал на почту​ = таблицу надо​Есть большой диапазон​ Осталось удалить дубликаты​

​Алгоритм действий следующий:​Список1​ в исходных списках​

​ пока еще не​ все ячейки, которые​ до Я».​ формулу для определения​

​Как выделить повторяющиеся ячейки​ Excel».​ =СУММЕСЛИ(A3:A9;C3;B3:B9)​В строке «Функция»​For j =​TheArk​ видео в архиве​ будет распечатываьь.​

Способ 3. Power Query

​ ячеек (более 2000).​ кнопкой​Открываем отдельную вкладку установленной​и​ могут быть как​ умеет работать более​ содержат в своем​Чтобы автоматически отметить повторяющиеся​ форматируемых ячеек» пишем​ в​Рассмотрим, как выделить​По такому принципу​ выбрали функцию «Сумма».​ 1 To UBound(a,​: Спасибо, кнопка Каратаева​ как делается​вариант KukLP именно​ Мне надо объединить​

​Удалить строки — Удалить​

1. ​ надстройки​Список2​​ уникальные элементы, так​​ чем с одной​ значении одинаковый год.​ ячейки и разделить​ такую формулу. =СЧЁТЕСЛИ($A:$A;A5)>1​​Excel.​​ и обозначить дубли.​ написать формулы в​
2. ​ Можно выбрать другие​ 2)​​ отлично помогла!​​После распаковки займет​ то что надо,​ повторяющиеся в столбце​ дубликаты (Delete Rows​
   
3. ​Power Query​, используя​ и совпадающие (и​ строкой. Сколько строк​​ Решение данной задачи​​ их линиями на​ Устанавливаем формат, если​
4. ​Установим формулу в​ У нас такая​​ других ячейках столбца​​ действия.​b(j) = a(i,​​vladFo​​ 5,8 Мб распаковавать​ тока проблемка в​ ячейки, а также​ — Delete Duplicates)​(если у вас​Диспетчер имен​ между списками и​ не выделяй он​ можно существенно упростить​ группы воспользуемся условным​ нужно выбрать другой​ столбце D, чтобы​
5. ​ таблица, в которой​ D. Получилось так.​​В строке «Ссылка»​​ j)​​: Проблема такая -​ раром проигравать в​​ том, что он​
   
6. ​ ряд ячеек находящихся​:​ Excel 2010-2013) или​на вкладке​​ внутри), но на​ все равно объединяет​​ с помощью готового​
   
7. ​ форматированием:​ цвет ячеек или​ автоматически писались слова.​ рассмотрим варианты работы​Эту же формулу можно​ поставили диапазон нашей​Next​ есть файл с​
8. ​ любом проигравателе кодеки​ заодно объединяет ячейки​​ рядом с ними.​​Готовый запрос можно переименовать​​ просто идем на​​Формулы (Formulas — Name​​ выходе нужно получить​ повторяющиеся значения только​ макроса.​Выделите диапазон A2:A11 и​ шрифта.​​ Формула такая. =ЕСЛИ(СЧЁТЕСЛИ(A$5:A5;A5)>1;»Да»;»Нет»)​
   
9. ​ с дублями.​ написать, вызвав диалоговое​ таблицы. У нас​
   
10. ​.Item(a(i, 1)) =​ товарами там есть​ не нужны звук​ и в первых​пример таблицы приложил.​ справа на панели​​ вкладку​ Manager — Create)​ список без дубликатов​​ в первой строке.​
    
11. ​Откройте редактор Visual Basic​ выберите инструмент: «ГЛАВНАЯ»-«Условное​Нажимаем «ОК». Все ячейки​Копируем формулу по​Дублирующие данные подкрасили условным​ окно функции «СУММЕСЛИ».​ указан фиксированный размер​ b​ строки с повторяющимися​​ не нужен​​ двух строках.​
    

​В данном случае​ параметров, дав ему​Данные​:​ (повторений):​​

planetaexcel.ru

Объединить повторяющиеся строки

​ (ALT+F11):​​ форматирование»-«Создать правило»-«Использовать формулу​ с повторяющимися данными​ столбцу. Получится так.​ форматированием.​ Она расположена на​ диапазона с абсолютными​End If​
​ значениями во всех​
​Алексей владимирович​
​помогите пожалуйста​
​ столбец с ячейками​
​ вменяемое имя (это​
​(если у вас​
​После именования, нужная нам​
​Давайте традиционно рассмотрим несколько​
​Если данный макрос должен​
​Создайте новый модуль с​
​ для определения форматированных​
​ окрасились.​

​Обратите внимание​​Есть два варианта​​ закладке «Формулы» в​​ ссылками и названием​

​End If​​ столбцах кроме 2х​: данные —-сортировка​

​KuklP​​ по которым идет​ будет имя таблицы-результата​ Excel 2016).​ формула будет выглядеть​

​ способов решения такой​ уметь работать сразу​ помощью инструмента: «Insert»-«Module».​ ячеек:».​Идея.​, что такое выделение​ выделять ячейки с​ разделе «Библиотека функций»​ столбцов. Можно написать​Next​ — к примеру​
​Palych​: Может покажете в​ отбор С:С. в​ по факту) и​Выделяем первый список и​ следующим образом:​ распространенной задачи -​ с несколькими выделенными​ А потом введите​
​В поле для ввода​Можно в условном​ дублей, выделяет словом​ одинаковыми данными. Первый​ нажимаем функцию «Математические»,​ диапазон с относительными​

CyberForum.ru

Объединение одинаковых ячеек и последующие обединение рядом стоящих

​ VBA-код:​​ значение: =$A2<>$A3​
​ цвет заливки и​ в ячейках, кроме​
​ все ячейки с​
​ диалоговое окно так.​
​Подробнее о видах​ In .Items​
​ столбцы с одинаковыми​
​ Данные > Сводная​
​ «и в первых​ вместе с ними​
​ лист командой​. На вопрос про​
​ самом деле, все​ сложных, но изящных.​
​ и настроив код.​Sub MergeDoubles()​
​Щелкните на кнопку «Формат»,​ шрифта. Получится так.​ первой ячейки.​
​ одинаковыми данными. Например,​В строке «Диапазон» указываем​
​ ссылок читайте в​
​Cells(rw, 1).Resize(1, UBound(a,​
​ значениями (например в​
​ таблица.​
​ двух строках»? На​
​ ячеки в тех​
​Закрыть и загрузить (Close&Load)​

​ создание из нашего​​ не так страшно.​Можно решить задачу самым​ В начале кода​
​Dim i As​ на вкладке «Граница»​Первые ячейки остались видны,​Слова в этой​ как в таблице​ диапазон столбца А​ статье «Относительные и​

​ 2)) = el​​ первом столбце один​Пользователь удален​ одном листе выполните​ же строках в​
​:​

​ списка «умной таблицы»​​ Давайте я разложу​ простым путем -​ добавим декларацию для​ Long​ следует задать оформление​

​ не видны. При​​ любые или числа,​ А8). Второй вариант​В строке «Критерий»​ Excel» здесь.​ + 1​ артикул) а в​TheArk​ — нет.​

​ – выделяем вторую​​ указываем ячейку столбца​

​Поставили галочки у​​Next​ столбце размер -​: Друзья подскажите как​burzuy​
​ есть похожее но​ в исходных списках,​ где будет видно​ сочетание клавиш Alt+Enter​
​ один и применить​

​Далее нам необходимо создать​​ Selection.Columns.Count To 2​В результате получаем эффект​ первом столбце меняются​ столбце E написали​ и следующие ячейки​

​ С, в которой​​ слов:​End With​

​ разные значения в​​ объединить текст в​: прикладываю​ все не то,​ достаточно будет лишь​ загруженные данные и​
​ и отступы пробелами,​ потом к полученному​ новый цикл, который​
​ Step -1​ как отображено на​

​ и пустые ячейки,​​ такую формулу. =ЕСЛИ(СЧЁТЕСЛИ(A$5:A5;A5)>1;»Повторно»;»Впервые»)​ в одинаковыми данными.​ будем писать название​«подписи верхней строки»​Application.ScreenUpdating = True​ каждой строке…файл в​ ячейках 2-го и​на лист2 результат​
​ а своих мозгов​

​ правой кнопкой мыши​​ имя запроса​ как мы делали,​

planetaexcel.ru

Как в Excel соединить повторяющиеся строки в одном столбце, чтобы их сумма сложилась

​ приложении…возможно ли объединить​​ 3-го столбца по​ после макроса. желтым​ не хватает.​
​ обновить таблицу результатов.​Таблица1​ например тут:​Удалить дубликаты​ до выполнения старого​ = Selection.Cells(1, i​

​Нам удалось объединить и​​ того, где находятся​

​ написали формулу. =ЕСЛИ(СЧЁТЕСЛИ(A$5:A5;A5)>1;»+»;»-«)​​ не выделять (выделить​В строке «Диапазон​ столбцов;​MsgBox «А ты​

​ строки или убрать​​ повторяющимся значением 1-го​

Как объединить текст в ячейках 2го столбца по повторяющимся (Формулы/Formulas)

​ я выделил ненужное​​заранее спасибо.​kamilat​(можно поменять на​Логика тут следующая:​с вкладки​ цикла. Так выглядит​ — 1) Then​ выделить повторяющиеся ячейки​

​ дубли.​​ Получилось так.​ только ячейку А8).​ суммирования» указываем диапазон​
​«значения левого столбца»​ боялась»​ дубликаты, но так​ столбца. Желательно, что​

​ объединение​​KuklP​: Здраствуйте, как можно​

​ свое, если хотите).​​Формула ИНДЕКС(Список1;ПОИСКПОЗ(0;СЧЁТЕСЛИ($E$1:E1;Список1); 0) выбирает​Данные (Data — Remove​ строка кода для​Range(Selection.Cells(1, i -​ в Excel. Теперь​

​Пятый способ.​​Идея.​​ Будем рассматривать оба​​ столбца В, числа​ — это значит,​End Sub​ чтоб эти разные​
​ бы при это​
​на лист3 до​: Sub www()​
​ в столбце найти​Делаем двойной щелчок в​ все уникальные элементы​
​ Duplicates)​
​ нового цикла, которую​ 1), Selection.Cells(1, i)).Merge​
​ в приходной накладной​Как найти повторяющиеся строки​
​Можно в таблице​ варианта.​ из ячеек которого​ что искать дубли​vladFo​ значения записались в​ удалились дубли.​ макроса. зеленым указал​
​Dim a As​
​ поторяющиеся значения и​ заголовок таблицы (слово​ из первого списка.​:​ следует добавить выше​End If​ все отсортированные поставщики​ в​
​ использовать формулу из​
​Первый способ.​
​ нужно сложить.​ в левом первом​: wild_pig,​
​ одну ячейку например​
​TimSha​

​ то что теряется​​ Range, i&​ объединить их? список​

excelworld.ru

Найти дубликаты и объединить значения строк (Макросы/Sub)

​Список1​​ Как только они​Само-собой, такой способ не​ уже имеющегося цикла:​Next​ визуально разграничены линией​Excel.​ столбца E или​Как выделить повторяющиеся значения​В строке формул​ столбце.​Отлично! Все работает!​ через запятую…​: А в чем​ после макроса.​Application.DisplayAlerts = 0​ большой по этому​) и переименовываем на​ заканчиваются — начинает​ подойдет, если данные​For j = 1​Selection.HorizontalAlignment = xlHAlignCenter​ друг от друга.​Нужно сравнить и​ F, чтобы при​
​ в​
​ сразу видна получившаяся​
​Нажимаем «ОК». Поучилось​
​ Сначала вроде ничего​

​было 1|2|3|0​​ вы видите ЦЕЛЕСООБРАЗНОСТЬ​​burzuy​​Application.ScreenUpdating = 0​ хочу формулу. Пожалуйста​ любой другой (например​

​ выдавать ошибку #Н/Д:​​ в исходных списках​ To Selection.Rows.Count​

​Application.DisplayAlerts = True​​​​ выделить данные по​​ заполнении соседнего столбца​Excel.​ формула.​

​ так.​​ не произошло! но​1|2|3|9​ сей заморочки?!​: прикладываю​On Error Resume​

​ помогите.​​Люди​Формула ИНДЕКС(Список2;ПОИСКПОЗ(0;СЧЁТЕСЛИ($E$1:E1;Список2); 0)) аналогичным​
​ часто меняются -​
​После инструкции конца первого​
​End Sub​
​Так как мы сортировали​ трем столбцам сразу.​
​ было сразу видно,​
​Нам нужно в​
​Третий способ.​
​Если таблицу консолидации делаем​
​ потом поменял колонку​
​1|2|3|8​
​Вариант - хранить​
​Z​
​ Next​пример:​
​). Каки именно назвать​ образом извлекает уникальные​
​ придется повторять всю​ цикла добавляем новую​
​Теперь если нам нужно​ поставщиков по их​
​ У нас такая​ есть дубли в​ соседнем столбце напротив​
​Создать таблицу с​ на другом листе,​
​ в скриптес 15​
​стало 1|2|3|0,9,8​ как есть, а​
​: А куда макрос​With Range("A2").CurrentRegion​стб А​
​ - не важно,​ элементы из второго​
​ процедуру после каждого​
​ строку с инструкцией​ объединить одинаковые ячейки​
​ идентификатору в формуле​
​ таблица.​
​ столбце или нет.​
​ данных ячеек написать​
​ фильтром. Внизу столбца​ то получится такая​
​ на 17, которая​Manyasha​
​ на показ перестроить​ дели?.. А сводную​
​.RemoveSubtotal​
​анна​
​ но придуманное название​
​ списка.​
​ изменения заново.​ конца для второго:​
​ в строке по​

​ мы зафиксировали смешанной​​В столбцах A, B,​​ Например, создаем список​ слово «Да», если​ В установить автосумму.​ таблица.​ мне нужна! СПАСИБО!!!​:​ — сводной, например…​

excelworld.ru

​ еще надо уметь​

MulTEx »

8 Июль 2015              38550 просмотров

Объединить по значению

Данная функция является частью надстройки MulTEx

---

Вызов команды:
MulTEx -группа Ячейки/Диапазоны —Ячейки —Объединить по значению

---

Иногда при подготовке итоговых отчетов для красоты необходимо объединять ячейки с одинаковыми значениями в одну. К примеру, есть такой отчет, выгруженный из 1С:

Вполне логично было бы перед тем как распечатать подобный отчет каждый город объединить визуально:

Делать это руками будет долго и неинтересно, особенно, если в отчете более пары тысяч строк. Как раз для того, чтобы объединить несколько ячеек с одинаковыми значениями, идущими подряд, и предназначена команда «Объединить по значению». Для этого необходимо выделить диапазон ячеек для объединения и вызвать команду: MulTEx -группа Ячейки и Диапазон —Ячейки —Объединить по значению.

Можно объединить либо по строкам, либо по столбцам.
Направление:

• По строкам — просмотр одинаковых значений и объединение ячеек происходит сверху вниз, а затем слева направо. Т.е. последовательно просматривается каждый столбец выделенных ячеек
• По столбцам — просмотр одинаковых значений и объединение ячеек происходит слева направо, а затем сверху вниз. Т.е. последовательно просматривается каждая строка выделенных ячеек

Данное действие невозможно отменить, поэтому следует осторожно его применять. Хотя можно произвести обратную операцию командой Разъединить с заполнением.

Предположим, у вас есть рабочий лист с одинаковыми данными в соседних строках, и теперь вы хотите объединить те же ячейки в одну, чтобы данные выглядели аккуратно и красиво. Как быстро и удобно объединить соседние строки с одинаковыми данными? Сегодня я познакомлю вас с быстрым способом решения этой проблемы.

---

Объединить соседние строки с одинаковыми данными с кодом VBA

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

1. Удерживайте ALT + F11 ключи, и он открывает Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модули, и вставьте следующий макрос в Модулиокно.

Sub MergeSameCell()
'Updateby Extendoffice
Dim Rng As Range, xCell As Range
Dim xRows As Integer
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xRows = WorkRng.Rows.Count
For Each Rng In WorkRng.Columns
    For i = 1 To xRows - 1
        For j = i + 1 To xRows
            If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
                Exit For
            End If
        Next
        WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
        i = j - 1
    Next
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

3, Затем нажмите F5 нажмите клавишу для запуска этого кода, на экране отобразится диалоговое окно для выбора диапазона для работы. Смотрите скриншот:

4. Затем нажмите OK, одни и те же данные в столбце A будут объединены. Смотрите скриншот:

---

Объединить соседние строки одних и тех же данных с Kutools for Excel

Для Объединить одинаковые ячейки полезности Kutools for Excel, вы можете быстро объединить одни и те же значения в нескольких столбцах одним щелчком мыши.

После установки Kutools for Excel, вы можете сделать следующее:

1. Выберите столбцы, в которых вы хотите объединить соседние строки с одинаковыми данными.

2. Нажмите Кутулс > Слияние и разделение > Объединить одинаковые ячейки, см. снимок экрана:

3. А затем те же данные в выбранных столбцах были объединены в одну ячейку. Смотрите скриншот:

Нажмите, чтобы скачать Kutools for Excel и бесплатная пробная версия прямо сейчас!

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

---

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

---

Лучшие инструменты для работы в офисе

Kutools for Excel Решит большинство ваших проблем и повысит вашу производительность на 80%

• Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма …
• Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон…
• Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы… Предотвращение дублирования ячеек; Сравнить диапазоны…
• Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор …
• Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое …
• Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии…
• Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом …
• Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF…
• Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.

---

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

• Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
• Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
• Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!

Комментарии (43)

Оценок пока нет. Оцените первым!

Объединение ячеек с одинаковыми значениями

ZatX Дата: Вторник, 23.05.2017, 21:46 | Сообщение № 1 Группа: Пользователи Ранг: Новичок Сообщений: 23 Репутация: 0 ± Замечаний: 0% ± Excel 2013 Доброе время суток, Господа! Помогите пожалуйста с макросом. Нужно объединить ячейки с одинаковыми значениями в сформировавшемся файле, на листе «Заказ», в колонке «Склад и магазины». Файл и скрин с желаемым результатом прилагаю. Сообщение отредактировал ZatX — Вторник, 23.05.2017, 21:56   Ответить

Pelena Дата: Вторник, 23.05.2017, 21:56 | Сообщение № 2 Группа: Админы Ранг: Местный житель Сообщений: 18797 Репутация: 4284 ± Замечаний: ± Excel 2016 & Mac Excel Здравствуйте. Обязательно макрос? Сводная не подойдёт? К сообщению приложен файл: 9477593.xls (69.0 Kb) «Черт возьми, Холмс! Но как??!!» Ю-money 41001765434816   Ответить

ZatX Дата: Вторник, 23.05.2017, 22:01 | Сообщение № 3 Группа: Пользователи Ранг: Новичок Сообщений: 23 Репутация: 0 ± Замечаний: 0% ± Excel 2013 Pelena, Спасибо за альтернативный вариант! Но этот файл «Заказ» Обрабатывается программой, и именно такой формат как на скрине нужен.   Ответить

ZatX Дата: Среда, 24.05.2017, 11:39 | Сообщение № 4 Группа: Пользователи Ранг: Новичок Сообщений: 23 Репутация: 0 ± Замечаний: 0% ± Excel 2013 Нашёл подходящий макрос, но как его адаптировать под мои нужды?) [vba] Код Sub Ob() Dim i&, n&, arr, rn& n = Cells(Rows.Count, 1).End(xlUp).Row + 1 Range(«A1:A» & n — 1).MergeCells = False For r = 2 To n — 1     If Cells(r, 1) = «» Then Cells(r, 1) = Cells(r — 1, 1) Next r arr = Cells(1, 1).Resize(n) rn = 1 Application.DisplayAlerts = False For i = 2 To n If arr(i, 1) <> arr(i — 1, 1) Then With Range(Cells(rn, 1), Cells(i — 1, 1)) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With rn = i End If Next Application.DisplayAlerts = True End Sub [/vba]   Ответить

sboy Дата: Среда, 24.05.2017, 12:15 | Сообщение № 5 Группа: Друзья Ранг: Участник клуба Сообщений: 2566 Репутация: 724 ± Замечаний: 0% ± Excel 2010 Добрый день. Вот такая добавочка в Ваш макрос [vba] Код ‘—————-     Application.DisplayAlerts = False     lr = Cells(Rows.Count, 5).End(xlUp).Row     xr1 = 2     Do While xr1 < lr         xr2 = Cells(xr1, 5).End(xlDown).Row         With Range(Cells(xr1, 5), Cells(xr2, 5))             .MergeCells = True             .HorizontalAlignment = xlCenter             .VerticalAlignment = xlCenter         End With         xr1 = xr2 + 2     Loop     Application.DisplayAlerts = True ‘————— [/vba] К сообщению приложен файл: 3342144.xls (61.0 Kb) Яндекс: 410016850021169   Ответить

ZatX Дата: Среда, 24.05.2017, 12:58 | Сообщение № 6 Группа: Пользователи Ранг: Новичок Сообщений: 23 Репутация: 0 ± Замечаний: 0% ± Excel 2013 sboy, всё круто!) Спасибо большое.+1 Вам к карме)   Ответить

Option Explicit
Option Base 1
'123456789012345678901234567890123456h8nor@ya567890123456789012345678toster56789

Sub Merge_by_Rows() ' Без форматирования границ
  Dim i As Integer, j As Integer, cnt As Integer
  Dim arr() As Variant, s As String
  
  With ActiveSheet.UsedRange ' Кол-во столбцов определяется по 1-й строке
    arr = Range(Cells(1, 1), Cells(.Rows.Count + 1, Range("A1").End(xlToRight).Column))
  End With
  
  cnt = 1: s = get_Row(arr, cnt)
  For i = LBound(arr, 1) + 1 To UBound(arr, 1)
    If get_Row(arr, i) <> s Then
      For j = LBound(arr, 2) To UBound(arr, 2)
        With ActiveSheet.Range(Cells(cnt, j), Cells(i - 1, j)).Offset(, UBound(arr, 2))
          .Merge
          .HorizontalAlignment = xlCenter
          .VerticalAlignment = xlCenter
          .Value = arr(cnt, j)
        End With
      Next j
      cnt = i: s = get_Row(arr, cnt)
    End If
  Next i
End Sub

Function get_Row(ByVal arr As Variant, ByVal num_Row As Integer) As String
  Dim j As Integer
  
  For j = LBound(arr, 2) To UBound(arr, 2)
    get_Row = WorksheetFunction.Trim(get_Row & " " & arr(num_Row, j))
  Next j
End Function

Процедуру выполнять на активном листе.