Объединить ячейки чтобы придать таблице читабельный вид очень часто существенно усложняется с увеличением объема данных. Так же весьма неблагодарным занятием является присвоение соответственных границ для ячеек. На помощь пользователям приходят макросы, благодаря которым все эти действия можно выполнить автоматически.
Автоматическое объединение большого количества ячеек по вертикали
Допустим мы имеем маркетинговый план внедрения нового информационного программного продукта:
Чтобы план было легче визуально анализировать лучше объединить ячейки этапов выполнения плана: 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 для обрыва строки во всех текстовых редакторах.
Потом остальной код макроса объединяет все ячейки столбцов в выделенном диапазоне, а потом заполняет их текстом из текстовой переменной. Чтобы не появлялось предупреждающее сообщение об объединении ячеек, в начале кода программы макроса отключаем отображение сообщений в Excel средствами программирования. Для этой цели используем свойство: Application.DisplayAlerts = Fale. После выполнения кода макроса изменяем значение свойства на True, чтобы в дальнейшем процессе работы с программой Excel все сообщения предупреждений (Alerts) имели возможность отображаться.
Внимание! Если ячейки выделенного диапазона будут содержать формулы, то после выполнения макроса эти формулы будут заменены на текст. В результате после объединения ячеек макросом, формулы могут быть утеряны.
Модернизация и настройка кода макроса для объединения ячеек
Если нам нужно изменить текст разделяющий отдельные строки символов содержащийся в целых ячейках, то можно вписать другой код символа, текст или несколько текстов соединенных символом амперсантом (&). Допустим мы хотим вставить между двумя символами разрыва строки текст, состоящий из пяти тире «——». Тогда данную строку следует модифицировать следующим образом:
intext = intext & Chr(10) & “——” & Chr(10) & Selection.Cells(j, i)
Если в объединенной ячейке мы хотим всегда вставлять только текст из первой ячейки в выделенном столбце (без текстов, записанных в остальных ячейках), тогда удалим или закомментируем переменную второго счетчика и часть кода второго цикла:
Если нам нужно чтобы выполнять макрос после выделения нескольких диапазонов (с удержанием клавиши CTRL), тогда можно добавить еще одну переменную, которая будет дополнять функцию счетчика:
Dim k As Long
Перед первым циклом добавим новую строку с кодом:
For k = 1 To Selection.Areas.Count
А после последнего цикла добавим строку конца нового цикла:
Next
Соответственно добавим новый отступ, чтобы код был более читабельным. Кроме того, после всех изменений для объекта Selection добавим ссылку на диапазон:
Selection.Areas(k)
Полная новая версия макроса для объедения ячеек выделенных нескольких диапазонов, выглядит так:
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 на клавиатуре:
В результате получаем идентичный вид таблицы с объединенными ячейками:
Читайте также:
Как разъединить объединенные ячейки в Excel используя макрос.
Как объединить столбцы в Excel используя макрос.
Если выполнить первую версию макроса (без всех этих изменений), для многократного выделения диапазонов с нажатой клавишей CTRL, то объединение строк по столбцам будет выполнено только для первого диапазона.
Добрый день!
Прошу помочь в с одним небольшим макросом.
в приложении книга. на 1 листе — то что есть, на 2ом — то что надо сделать. а именно, сгруппировать объединенные строками ячейки, оставив первые 3 строчки в качестве шапки. (не уверен что в 2003 Excel есть группировка)
ниже макрос, он бесполезный, ибо работает с абсолютными адресами ячеек.
поэтому отсюда вопрос: как научить его распознавать.. диапазон чтоли строчек, которые входят в одну объединенную ячейку, выделять их и группировать.
вопрос: как научить его правильно выделить эту область
Sub Macros1()
Rows(«4:7»).Select
Selection.Rows.Group
Rows(«11:12»).Select
Selection.Rows.Group
Rows(«16:19»).Select
Selection.Rows.Group
Rows(«23:29»).Select
Selection.Rows.Group
End Sub
P.S. строчки в объединенных ячейках будут добавляться со временем поэтому абсолютные координаты не подойдут
спасибо!
I have a similar question to this one:
Merge the contents of 2 cells into another 3rd cell using VBA in Excel
But I want to combine a range of cells within a column, eg A2:A50. Sometimes I have over 300 cells to be combined into one. Values are text. Is there any way to modify this macro so that it works on a range instead of just two cells?
Thanks!
asked Jan 18, 2010 at 22:45
Based on the thread you are citing, I guess you wish to return the concatination of all the values held by the cells, interpreting all the values as strings?
For that, you could use a VBA macro that looks like this:
Function ConcatinateAllCellValuesInRange(sourceRange As Excel.Range) As String
Dim finalValue As String
Dim cell As Excel.Range
For Each cell In sourceRange.Cells
finalValue = finalValue + CStr(cell.Value)
Next cell
ConcatinateAllCellValuesInRange = finalValue
End Function
As an example, you could call it like this:
Sub MyMacro()
MsgBox ConcatinateAllCellValuesInRange([A1:C3])
End Sub
Is this what you were looking for?
Mike
answered Jan 18, 2010 at 23:18
Mike RosenblumMike Rosenblum
12k6 gold badges48 silver badges64 bronze badges
Try the following macro, not very elegant in that it doesn’t do any error checking etc but works. Assign the macro to a button, click in a cell, click the macro button, highlight the desired (source) range to merge using your mouse (will autofill in range in the input box in the dialogue box), click ok, highlight the destination cell (will autofill the input box in the next dialogue box) click ok, all cells will be merged with a single space character into the destination cell, which can be in the original source range). Up to you to delete the superfluous cells manually. Workks with both rows and columns but not blocks.
Sub JoinCells()
Set xJoinRange = Application.InputBox(prompt:="Highlight source cells to merge", Type:=8)
xSource = 0
xSource = xJoinRange.Rows.Count
xType = "rows"
If xSource = 1 Then
xSource = xJoinRange.Columns.Count
xType = "columns"
End If
Set xDestination = Application.InputBox(prompt:="Highlight destination cell", Type:=8)
If xType = "rows" Then
temp = xJoinRange.Rows(1).Value
For i = 2 To xSource
temp = temp & " " & xJoinRange.Rows(i).Value
Next i
Else
temp = xJoinRange.Columns(1).Value
For i = 2 To xSource
temp = temp & " " & xJoinRange.Columns(i).Value
Next i
End If
xDestination.Value = temp
End Sub
answered Aug 23, 2011 at 15:15
Just to add to Mike’s solution, if you want to get your range from a variable instead of a defined range (I had trouble with the syntax):
Sub MyMacro()
dim myVar As Range
MsgBox ConcatinateAllCellValuesInRange(myVar)
End Sub
answered Apr 13, 2015 at 9:55
Here is a macro developed circa 2006.
I still use it today!
Usage:
- Select the cells you want to merge (the marco assumes they are all in the same column, one below the other)
- Run the macro (a good idea is to assign it a short-cut key via Excel’s Developer->Code->Macros-> select the macro -> Options)
Sub MergeCells()
'
Dim myString As String
Dim myUnion As Range
Count = Selection.Count
myValue = Selection
myrow = Selection.Row
mycol = Selection.Column
myString = ""
For Index = 1 To Count
If Index > 1 Then myString = myString & Chr(10) & myValue(Index, 1) Else myString = myValue(Index, 1)
Next Index
Selection.ClearContents
Cells(myrow, mycol) = myString
' Uncomment this loop if you want to delete the rows that are below the top cell (the rows with the cells whose content was concatenated to the top cell)
' For Index = 1 To Count - 1
' Rows(myrow + 1).Delete
' Next Index
Cells(myrow, mycol).Select
End Sub
answered Mar 25 at 18:02
|
Удаление строк с объединёнными ячейками |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
