Макрос для разъединения ячеек в excel

В программе Excel присутствует кнопка для разъединения объединенных ячеек таблицы на закладке: «ГЛАВНАЯ»-«Выравнивание»-«Отменить объединение ячеек». Но что, если эту операцию нужно выполнять многократно, да еще и после нее заполнять данными ново созданные ячейки. Реализовать данную задачу вручную – это весьма затратное занятие по времени и силам. Здесь рационально воспользоваться макросом.

Макрос для разъединения объединенных ячеек в Excel

Допустим у нас уже имеется вполне читабельная таблица списка заказов, в которой имеются объединенные ячейки в столбце «Год». Пример, такой таблицы изображен ниже на рисунке:

Но нам необходимо преобразовать данную таблицу в стандартный формат, например, для создания отчета на основе сводной таблицы. Для этого откроем редактор Visual Basic (ALT+F11):

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

Sub RazdelitVstavit()
Dim adres As String
adres = ActiveCell.MergeArea.Address
If adres <> ActiveCell.Address Then
  ActiveCell.UnMerge
  ActiveCell.Copy
  ActiveSheet.Paste ActiveSheet.Range(adres)
  Application.CutCopyMode = False
End If
End Sub


Если мы хотим отменить объединение ячеек в столбце «Год» и заполнить созданные ячейки соответствующими значениями (годами), тогда перейдите на одну большую объединенную ячейку B2 и запустите макрос: «РАЗРАБОТЧИК»-«Код»-«Макросы»-«RazdelitVstavit»-«Выполнить».

В данном VBA коде макроса используется только одна переменная. Она хранит в себе адрес диапазона ячеек B2:B15 которые охватывает одна активная объединенная ячейка.

adres = ActiveCell.MergeArea.Address

Адрес активной ячейки отображается в поле «Имя» (напротив строки формул Excel). Но там не отображается полный адрес объединенной ячейки.

Для пользователя в поле «Имя» будет адрес отображаться одинаково, но в макросе их можно различить с помощью методов объекта ActiveCell.MergeArea.Addres. В зависимости какой тип активных ячеек будет возвращен тип адреса – одна ячейка или диапазон. Если активная ячейка не является объединенной, тогда в переменной будет храниться только адрес одной активной ячейки, а не целого диапазона. Далее макрос проверяет является ли текущая активная ячейка – объединенной, с помощью сравнения двух способов получения адреса для одной и той же активной ячейки. Тот способ, который передал адрес в переменную из метода объекта ActiveCell.MergeArea.Addres и обычный – ActiveCell.Addres. Если адрес в переменной и адрес получен обычным способом не совпадает, значит она является объединенной и код выполняется дальше.

С помощью метода объекта ActiveCell.UnMerge выполняется разъединение объединенной активной ячейки. Далее копируется ее содержимое и заполняется диапазон на листе, адрес которого получен из переменной, его же ранее содержала в себе объединенная активная ячейка. После копирования значения для объекта CutCopyMode устанавливается свойство False, чтобы прекратить процесс копирования. В результате таблица листа заказов будет иметь такой же вид как показано ниже на рисунке:

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

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



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

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

Dim i As Long

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

For i = 1 To Selection.Count

В конце кода не забудем добавить конец цикла:

Next

Вместо ссылки на активную ячейку Active.Cell теперь будем использовать ссылку на очередную по счету ячейку в выделенном диапазоне: Selection.(i). Полная версия усовершенствованного макроса выглядит следующим образом:

Sub RazdelitVstavit()
Dim adres As String
Dim i As Long
For i = 1 To Selection.Count
  adres = Selection(i).MergeArea.Address
  If adres <> Selection(i).Address Then
    Selection(i).UnMerge
    Selection(i).Copy
    ActiveSheet.Paste ActiveSheet.Range(adres)
    Application.CutCopyMode = False
  End If
Next
End Sub


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

Читайте также: Как объединить ячейки в Excel с помощью кода макроса VBA.

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

Правильно разъединить ячейки макросом

Модератор:Naeel Maqsudov

Sub Un_Merge()
    a = Cells(1, 1)
    Cells(1, 1).UnMerge
    Range(Cells(1, 1), Cells(3, 1)) = a
End Sub

Sub Un_Merge_AllSelected()
 Dim c As Range
 Dim ma As Range
 Dim a As Variant
 For Each c In Selection
    With c
      If .MergeCells Then
        Set ma = .MergeArea
        a = c.Value
        .MergeArea.UnMerge
        ma.Value = a
      End If
    End With
 Next
End Sub

Может и мой корявенький макрос кому-нибудь пригодится. Обрабатывает таблицу HTML, в которой в полях одной записи встречаются и объединенные и отдельные ячейки. В результате получается запись в одной строке, а лишние удаляются. Для наглядности кусочек исходной таблицы в файле.  
Sub UnMergeAndPack()    ‘ Если в поле А есть объединенные строки (ячейки) разъединяет их  
   Dim iCell As Range      ‘ а из необъединенных ячеек собирает текст в верхнюю ячейку.После этого  
   Dim nRow As Long        ‘ удаляет строки с пустыми ячейками в столбце А  
   Dim howRow As Integer  
   Dim endRow As Long  
   Dim nCol As Integer  
   Dim addRow As Long  
   Dim iLastRow As Long  
   Application.DisplayStatusBar = True  
   ‘Установка текста строки состояния.  
   Application.StatusBar = «Преобразование таблицы»  
   Application.ScreenUpdating = False                 ‘Отключить обновление экрана  
   iLastRow = ActiveSheet.UsedRange.Row — 1 + ActiveSheet.UsedRange.Rows.Count  
   For Each iCell In Range(«A3:A» & iLastRow)  
       With iCell  
           If .MergeCells And .Address = .MergeArea.Cells(1).Address Then  ‘ Если ячейка Merge и она первая в Merge  
               nRow = iCell.Row                    ‘ номер первой строки в объкдиненной ячейке  
               howRow = .MergeArea.Rows.Count      ‘ кол-во строк в объединенной ячейке  
               endRow = nRow + howRow — 1          ‘ номер последней строки в объединенной ячейке  
                   For nCol = 1 To 7               ‘ обработка записи в полях  
                       If Cells(nRow, nCol).MergeCells = True Then ‘ Если ячейка объединенная,  
                           Cells(nRow, nCol).UnMerge   ‘ то разъединяем  
                           Else  
                              For addRow = nRow + 1 To endRow  ‘ если ячейки отдельные, то собираем из них текст в верхнюю ячейку  
                               Cells(nRow, nCol) = Cells(nRow, nCol) & Chr(10) & Cells(addRow, nCol)  
                              Next addRow  
                       End If  
                   Next nCol  
           End If  
       End With  
   Next  

         iLastRow = ActiveSheet.UsedRange.Row — 1 + ActiveSheet.UsedRange.Rows.Count  
   Range(«A2», «G» & iLastRow).AutoFilter Field:=1, Criteria1:=»=», Operator:=xlFilterValues ‘ Фильтрация по «Пусто» в поле А  
   Range(«A3:A» & iLastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete ‘ Удаление отфильтрованных строк  
   Range(«A2», «G» & iLastRow).AutoFilter ‘ Отключение автофильтра  

         ActiveSheet.UsedRange.Replace Empty, «insert», xlWhole ‘ Устанавливаем рабочую область  
   ActiveSheet.UsedRange.Replace «insert», Empty          ‘ по размерам таблицы  

         Columns(«B:G»).EntireColumn.AutoFit ‘ Автоподбор ширины ячеек  
   Cells.EntireRow.AutoFit             ‘ Автоподбор высоты ячеек  
Range(«H2»).Select  
   Application.ScreenUpdating = True  
   Application.StatusBar = False  

  End Sub