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

Создание объединенной ячейки с сохранением всех записей

К примеру вложен файл с образцом, его можно скачать по кнопке. Excel-VII: Создание макросов в Excel VBA с нуля (24 ак.ч.)

Остались в наше время юзеры, которые не работали бы с объединенными ячейками? Вопрос, скорее, шуточный, нежели серьёзный :) Но вот к серьёзным проблемам привести он, однако, может. А все потому, что объединение ячеек сохраняет текст только первой из заполненных ячеек, остальной удаляет безвозвратно. Как же быть, если необходимо объединить несколько ячеек в одну, но при этом сохранить все данные? Как на картинке ниже, например:

Стандартными средствами здесь не обойтись, поэтому используем макрос. Можно скачать прикрепленную к уроку книгу, открыть ее вместе с тем файлом, в котором будете работать, а затем придерживаться следующей последовательности действий:

Этот макрос объединит ячейки по горизонтали с сохранением всех записей, при этом добавит пробелы между текстом разных ячеек. При желании можно забрать этот макрос в любую свою книгу, для этого сначала сохраните, используя тип с поддержкой макросов. Затем открываем редактор VBA (Alt+F11 , например, или Разработчик-Код-VisualBasic), создаем новый модуль (Insert-Module) и копируем в него приведенный ниже код. Далее сохраняем книгу и работаем в обычном режиме.

Этот макрос входит в курс "МАКРОСЫ НА VBA С НУЛЯ", там я рассказываю подробно логику, синтаксические и орфографические правила языка VBA, чтобы подобные макросы Вы смогли бы составлять сами. Буду рада видеть Вас на обучении.

ПРОГРАММА И СТОМОСТЬ КУРСА.

 

Sub Объединение_горизонталь()

If Selection.Cells.Count = 1 Then 'если выделена одна ячейка

   MsgBox "Выдели несколько ячеек!", vbCritical

   Exit Sub 'выход из макроса

End If

If Selection.Rows.Count > 1 Then 'если выделена горизонталь

   MsgBox "Выдели горизонталь, а не вертикаль!", vbCritical

   Exit Sub 'выход из макроса

End If

Application.DisplayAlerts = False 'выключить диалоговые окна

'для каждой ячейки в зоне выделения

For Each Rng In Selection

 'в текстовую переменную собрать текст из всех ячеек

  If Rng <> "" Then tt = tt & Rng & " "

Next

'Debug.Print tt

'очистить переменную от последнего лишнего знака

tt = Left(tt, Len(tt) - 1)

Selection.Merge 'объединить выделенные ячейки

Selection = tt 'записать в ячейку текст из переменной

Selection.HorizontalAlignment = xlCenter 'вертикальное выравнивание текста в ячейке

Application.DisplayAlerts = True 'включить диалоговые окна

End Sub

 

Можно внедрить этот макрос как кнопку на Панель быстрого доступа – для этого вызовите контекстное меню правой кнопкой мыши в любом месте Панели быстрого доступа и выберите команду Настройка панели быстрого доступа, далее в правой части под стрелкой левого списка находим Макросы, выбираем Объединить_и_сохранить и при помощи кнопочки Добавить перебросьте в правый список. Настроить внешний вид кнопки с этим макросом можно при помощи команды Изменить в нижней части окна