Vba excel ячейка автоподбор по высоте

Подбор высоты строки/ширины столбца объединенной ячейки

Для начала немного теории. Если в ячейках листа Excel записан некий длинный текст, то обычно устанавливают перенос на строки(вкладка Главная -группа Выравнивание —Перенос текста), чтобы текст не растягивался на весь экран, а умещался в ячейке. При этом высота ячейки тоже должна измениться, чтобы отобразить все содержимое. Если речь идет всего об одной простой ячейке — проблем не возникает. Обычно, чтобы установить высоту строки на основании содержимого ячейки, достаточно навести курсор мыши в заголовке строк на границу строки(курсор приобретет вид направленных в разные стороны стрелок — ) и дважды быстро щелкнуть левой кнопкой мыши. Тоже самое можно сделать и для ширины столбцов.
Но с объединенными ячейками такой фокус не прокатывает — ширина и высота для этих ячеек так не подбирается, сколько ни щелкай и приходится вручную подгонять каждую, чтобы текст ячейки отображался полностью:

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

‘————————————————————————————— ‘ Procedure : RowHeightForContent ‘ Author : The_Prist(Щербаков Дмитрий) ‘ http://www.excel-vba.ru ‘ Purpose : Функция подбирает высоту строки/ширину столбца объединенных ячеек по содержимому ‘————————————————————————————— Function RowColHeightForContent(rc As Range, Optional bRowHeight As Boolean = True) ‘rc — ячейка, высоту строки или ширину столбца которой необходимо подобрать ‘bRowHeight — True — если необходимо подобрать высоту строки ‘ False — если необходимо подобрать ширину столбца Dim OldR_Height As Single, OldC_Widht As Single Dim MergedR_Height As Single, MergedC_Widht As Single Dim CurrCell As Range Dim ih As Integer Dim iw As Integer Dim NewR_Height As Single, NewC_Widht As Single Dim ActiveCellHeight As Single If rc.MergeCells Then With rc.MergeArea ‘если ячейка объединена ‘запоминаем кол-во столбцов iw = .Columns(.Columns.Count).Column — rc.Column + 1 ‘запоминаем кол-во строк. ih = .Rows(.Rows.Count).Row — rc.Row + 1 ‘Определяем высоту и ширину объединения ячеек MergedR_Height = 0 For Each CurrCell In .Rows MergedR_Height = CurrCell.RowHeight + MergedR_Height Next MergedC_Widht = 0 For Each CurrCell In .Columns MergedC_Widht = CurrCell.ColumnWidth + MergedC_Widht Next ‘запоминаем высоту и ширину первой ячейки из объединенных OldR_Height = .Cells(1, 1).RowHeight OldC_Widht = .Cells(1, 1).ColumnWidth ‘отменяем объединение ячеек .MergeCells = False ‘назначаем новую высоту и ширину для первой ячейки .Cells(1).RowHeight = MergedR_Height .Cells(1, 1).EntireColumn.ColumnWidth = MergedC_Widht ‘если необходимо изменить высоту строк If bRowHeight Then ‘.WrapText = True ‘раскомментировать, если необходимо принудительно выставлять перенос текста .EntireRow.AutoFit NewR_Height = .Cells(1).RowHeight ‘запоминаем высоту строки .MergeCells = True If OldR_Height ‘ .WrapText = True ‘раскомментировать, если необходимо принудительно выставлять перенос текста тогда код сам проставит переносы. Но тут следует учитывать, что в данном случае перенос будет выставлен для всех ячеек, что не всегда отвечает условиям

функция подбирает высоту и ширину исключительно для объединенных ячеек. Если ячейка не объединена — код оставит её без изменений

Теперь о том, как это работает и как применять. Для начала необходимо приведенный выше код функции вставить в стандартный модуль. Сама по себе функция работать не будет — её надо вызывать из другого кода, который определяет какие ячейки обрабатывать. В качестве такого кода я предлагаю следующий:

Sub ChangeRowColHeight() Dim rc As Range Dim bRow As Boolean bRow = (MsgBox(«Изменять высоту строк?», vbQuestion + vbYesNo, «www.excel-vba.ru») = vbYes) ‘bRow = True: для изменения высоты строк ‘bRow = False: для изменения ширины столбцов Application.ScreenUpdating = False For Each rc In Selection RowColHeightForContent rc, bRow Next Application.ScreenUpdating = True End Sub

Этот код также необходимо вставить в стандартный модуль. Теперь его можно будет вызвать из этой книги, нажатием клавиш Alt+F8 и выбрав ChangeRowColHeight , или создав на листе кнопку и назначив ей макрос. После этого достаточно будет выделить диапазон ячеек, среди которых есть объединенные и вызвать макрос ChangeRowColHeight. Для всех объединенных ячеек в выделенном диапазоне будет подобрана высота или ширина.
Чтобы было нагляднее — я приложил пример, в котором помимо самих кодов есть вырезка из стандартной накладной. Именно в таких документах наиболее часто встречаются подобные казусы и необходимость подбирать высоту и ширину объединенных ячеек.
Скачать пример:

Tips_Macro_HeightWidthInMergeCell.xls (64,0 KiB, 3 444 скачиваний)

Если подобную операцию приходится производить постоянно — советую коды записать в надстройку: Как создать свою надстройку?. Так же можно воспользоваться уже готовым решением в составе MulTEx — Высота/Ширина объединенной ячейки.

Источник

VBA Excel. Автоподбор высоты объединенной ячейки

Автоподбор высоты объединенной ячейки с помощью кода VBA Excel, когда метод AutoFit не работает. Обработка ячеек по списку адресов из массива.

Автоподбор высоты ячейки

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

Здесь мы рассмотрим макрос для автоподбора высоты ячейки, объединенной с другими по горизонтали в одной строке, которые обычно используются в заголовках электронных таблиц Excel. Для объединенной ячейки должен быть задан перенос текста по словам: Формат ячеек >> Выравнивание >> переносить текст .

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

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

1. Длину текста (количество символов) в объединенной ячейке.
2. Ширину объединенной ячейки. Длина одного символа текста со шрифтом и его размером по умолчанию приблизительно соответствует длине символа, в котором измеряется ширина ячейки.
3. Размер шрифта, чтобы рассчитать коэффициент, увеличивающий или уменьшающий высоту ячейки в зависимости от его (шрифта) размера.

Макрос VBA Excel для автоподбора высоты ячейки с учетом размера используемого шрифта:

• myCell — отдельная ячейка в объединенной;
• myLen — длина текста в активной ячейке;
• myWidth — ширина объединенной ячейки;
• k — коэффициент, вносящий поправку в зависимости от размера шрифта;
• n — размер шрифта по умолчанию.*

* Это не точное значение: у меня по умолчанию установлен шрифт Calibri размером 11, но точнее код работает с n = 10. Значение переменной n подбирается опытным путем, так как длина текста зависит от процентного соотношения широких и узких символов, если шрифт не моноширинный. Переменной n можно присваивать и дробные значения для более точного автоподбора высоты.

Максимальная высота строки — 409,5. Если расчетная высота объединенной ячейки окажется больше, будет сгенерирована ошибка.

Данный код VBA Excel работает с выделенной ячейкой. Вы можете задать список адресов объединенных ячеек и пройтись макросом по каждой из них.

Обработка списка ячеек

Укажите список объединенных ячеек в качестве аргументов функции Array. Для списка используйте адреса только первых ячеек из состава объединенных.

• myCell — массив со списком адресов объединенных ячеек;
• myElem — используется как элемент массива myCell.

Макрос ObkhodYacheyek по адресам из списка обращается к каждой ячейке по очереди, выделяет ее и запускает код автоподбора высоты PodborVysoty.

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

12 комментариев для “VBA Excel. Автоподбор высоты объединенной ячейки”

Здравствуйте, Евгений. А если сделать проверку каждой строки, ограничив по количеству строк и ячеек, сильно на производительности скажется? Или лучше прописывать
myCell = Array(«A1», . «A2000») ?

Добрый день, Алексей!
Сравните время выполнения обоих вариантов вашего кода.

Евгений, подскажите пожалуйста первый вариант, я думаю он длинный, да и я его не осилю.

Да нет, он не длинный, но вряд ли вам подойдут оба варианта, так как замедляет код метод .Select . Я то рассчитывал, когда писал эти коды, на небольшое количество объединенных ячеек. Замерьте время выполнения у этого варианта и напишите, что получилось:

Запускайте код не из редактора VBA, а кнопкой на рабочем листе или пользовательской форме, так он работает быстрее.

Вводная: у меня документ разноплановый и большой (32 ячейки (ширину подгонял для формата А4) на 2000 строк), т.е. присутствуют строки объединённые в одну (текст многострочный и однострочный), есть таблицы (как однострочные в ячейке, так и многострочные и с картинками в строках и с вертикальным текстом). В основном в строках, это формулы эксель, но есть и просто текст.
Отчёт по работе макроса. Засечь время не удалось, наблюдал работу макроса. Результат работы:
1. не правит одинарную строку (на 32 ячейки) многострочный текст, как было до работы макроса, так и осталось;
2. правит одинарную строку однострочный текст (местами отсутствует эта работа, необходимы ещё тесты, чтобы с уверенностью высказать);
3. таблицу с однострочными текстами правит хорошо;
4. в таблице с многострочными текстами есть нюансы, подгоняет ширину под первую ячейку, т.е. если во второй ячейке этой же строки есть более многострочный текст ширина строки определяется по первой ячейке и во второй содержание «съедается»;
5. вертикальные тексты в ячейках, отсутствуют боковые отступы от грани таблицы до текста;
6. если есть в документе пустая строка с ячейками не объединённая, макрос её (строку) ширину смещает в ноль;
Имеются ещё мелкие огрехи, но тут надо ещё тестировать и пробовать.
Много слов получилось и неутешительных. Если мой пост будет мешать вашей работе, можете его не публиковать. За правками макроса можно будет к вам обращаться?

За небольшими правками можете обращаться. Вот одна из них:

Это для того, чтобы не скрывались пустые строки.

А по п.1 не правит одинарную строку (на 32 ячейки) многострочный текст, можно сделать правку? или это по другой теме?

Я не совсем понял: многострочный текст в ячейке, объединенной из 32 ячеек?

Описывал процесс и понял, надо проще. Открываем новый документ эксель и ячейку А1 объединяем с ячейкой В1 получим строку (объединённая ячейка А1). Вот в неё вставляем многострочный текст (с переносом слов). Если не менялись размеры стандартных ячеек, то в такую объединённую ячейку в одну строку можно напечатать 17 букв «а». 18 буква сместится её можно будет увидеть только, если расширишь строку. Вот и получается строка одна, а в ней многострочный текст.

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

Привет.
Я придумал метод, как подстроить высоту объединенной ячейки с длинным текстом с помощью AutoFit, который встроен в Excel.
Идея заключается в том, чтобы на пустом (новом) листе завести обычную ячейку (формат естественно с переносом текста).
Если в нее скопировать текст из исходной объединенной ячейки, то он автоматом разобъется на строки и высота этой конечной ячейки даст нам искомую высоту для такой же объединенной ячейки.
Проблема в том, чтобы подобрать ширину одиночной ячейки такую, чтобы текст из объединенной ячейки «укладывался» в нее аналогичным образом. Ибо, как выяснилось в процессе эта ширина хоть и зависит линейно от ширины исходной ячейке, но не равна ей.
Например.
У меня есть объединенная ячейка, которая получилась объединением 62 одинаковых ячеек шириной 1.43 пункта.
Шрифт Coliri, 11, обычный.
«Ширина» объединенной ячейки получается 1.43 х 62 = 88.6
Так вот для обычной ячейки этой ширины оказалось мало.
Чтобы текст из исходной ячейки уложился в обычной в те же 5 строк, потребовалось задать ширину конечной ячейки 139.
То есть при выборе ширины обычной конечной ячейки нужно применять коэффициент 1.55-1.56 (в моем случае).
Возможно этот коэффициент постоянный, возможно зависит как он выбранного шрифта, так и от количества объединяемых ячеек и их исходной ширины и моноширинности (этот вопрос я не исследовал).
Но в итоге метод работает.
Я завожу обычную ячейку нужной ширины записываю в нее текст из исходной объединенной, текст автопереносится, и я получаю высоту для объединенной ячейки из свойств обычной.

Существенное замечание.
Формат ячейки для работы с длинным текстом должен быть «Общий» («General»).
При записи же в ячейку с форматом «Текстовый» строки более 256 символов отображаются ############ и автофит не работает.
Если формат Общий, то все работает и отображается как нужно.

Источник

VBA AutoFit (Rows, Column, or the Entire Worksheet)

Key Points

• In VBA, you can use the AutoFit method to auto-fit rows, columns, and even an entire worksheet.
• You need to specify the range, and then you can use the AutoFit method.

AutoFit a Column

Let’s say you want to autofit column A, the code would be something like below:

In the above line of code, you have used the EntireColumn property to refer to the entire column of cell A1.

As you are within a worksheet so you can also use the columns property and write a code like the below.

AutoFit a Row

In the same way, you can write code to autofit a row. Let’s say you want to autofit row 5, the code would be:

And if you want to use the row property, then you can use the code like the following.

AutoFit UsedRange (Rows and Columns)

Now let’s say, you only want to autofit those columns and rows where you have data. In VBA, there is a property called used range that you can use. So the code would be.

And if you want to use a specific worksheet then the code would be.

AutoFit Entire Worksheet

And if you want to refer to all the columns and rows of the worksheet then you can use the “CELLS” property. Here’s the code.

Or you can also use VBA’s WITH statement to write a code like the below.

Источник