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

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

Как объединить 2 и несколько столбцов в таблице Excel

Допустим, что мы имеем таблицу содержащую данные оп договорам и выставленных на их основе счетов. Данные по договорам находиться в столбцах D, E и F, но некоторые фактуры взяты с других подчиненных документов, а не из договора. Для таких случаев в столбце D указывается номер договора или описание подчиненного документа для каждой фактуры.

данные оп договорам.

Нам необходимо объединить ячейки в этих трех столбцах (D, E и F) таким образом, чтобы для каждой строки где нет договоров была одна объединенная ячейка.

Откроем редактор Visual Basic (ALT+F11):

Visual Basic.

И вставим новый стандартный модуль используя инструмент в редакторе: «Insert»-«Module». А после чего запишем в модуль VBA код макроса для объединения ячеек столбцов по горизонтали:

Sub ObedinitGorizontal()
Dim i As Long
Dim j As Long
Dim savetext As String
Application.DisplayAlerts = False
For i = 1 To Selection.Rows.Count
  savetext = Selection.Cells(i, 1)
  For j = 2 To Selection.Columns.Count
    savetext = savetext & Chr(32) & Selection.Cells(i, j)
  Next
  Selection.Rows(i).Merge
  Selection.Cells(i, 1) = savetext
  Selection.Cells(i, 1).HorizontalAlignment = xlHAlignCenter
Next
Application.DisplayAlerts = True
End Sub
Код VBA.

В первом цикле данного кода выполняется прогон по отдельных строках выделенного диапазона, а во втором объединяться значения столбцов в Excel. Тексты между собой разделяться символом пробела, его код в таблице символом ASCII имеет номер 32.

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

Если мы хотим объединить ячейки в строках содержащих информацию о выставленных счетах без подчиненных договоров, выделяем диапазон ячеек D5:F7 и запускаем наш макрос: «РАЗРАБОТЧИК»-«Код»-«Макросы». В появившемся диалоговом окне выбираем имя нашего макроса «ObedinitGorizontal» и нажимаем на кнопку «Выполнить». А далее снова выделяем диапазон ячеек D9:F11 и вновь запускаем макрос «ObedinitGorizontal». В результате ячейки будут объединены как показано ниже на рисунке:

В результате объединены ячейки.

Внимание! Если объединяемые ячейки будут содержать формулы, то они могут быть утеряны так как в процессе объединения формулы преобразуются в интерпретированный текст.

Модификация и настройка кода макроса

Если мы хотим разделять тексты не пробелом, а вертикальной линией, тогда нужно просто изменить ASCII код в аргументе функции Chr() на 124:

savetext = savetext & Chr(124) & Selection.Cells(i, j)

Если в объединенных ячейках мы хотим вставлять только тексты из первого столбца (D), без текстов, записанных в остальных двух столбцах E и F тогда удалите или закомментируйте переменную j и код второго цикла:

закомментируйте переменную j и код .

Как объединить ячейки по столбцам в Excel

Если мы хотим выполнить макрос одновременно и сразу для нескольких выделенных диапазонов ячеек (с помощью удержания клавиши CTRL на клавиатуре), добавим еще одну переменную:

Dim k As Long

Перед первым циклом добавим строку для начала нового цикла прохода по всех выделенных диапазонах:

For k = 1 To Selection.Areas.Count

В конце первого цикла не забудьте добавить конце для нового цикла:

Next

Кроме этого для всех элементов объекта Selection следует добавить ссылку на диапазон: Selection.Areas(k). Полная версия VBA кода модифицированного макроса выглядит следующим образом:

Sub ObedinitGorizontal()
Dim i As Long
Dim j As Long
Dim k As Long
Dim savetext As String
Application.DisplayAlerts = False
For k = 1 To Selection.Areas.Count
  For i = 1 To Selection.Areas(k).Rows.Count
    savetext = Selection.Areas(k).Cells(i, 1)
    For j = 2 To Selection.Areas(k).Columns.Count
      savetext = savetext & Chr(32) & Selection.Areas(k).Cells(i, j)
    Next
    Selection.Areas(k).Rows(i).Merge
    Selection.Areas(k).Cells(i, 1) = savetext
    Selection.Areas(k).Cells(i, 1).HorizontalAlignment = xlHAlignCenter
  Next
Next
Application.DisplayAlerts = True
End Sub

Читайте также: Как разъединить объединенные ячейки в Excel используя макрос.

Если хотите узнать как объединить строки в Excel, читайте статью: макрос для объединения строк в таблице.

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