Vba excel автоподбор высоты строк

Изменение размера ячейки в VBA Excel. Высота строки, ширина столбца, автоподбор ширины ячейки. Свойства RowHeight и ColumnWidth объекта Range.

Размер ячейки

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

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

Информационные окна с высотой строки и шириной столбца в Excel

Высота строки и ширина столбца в Excel

Программно, без дополнительных макросов, можно изменять высоту строки только в пунктах, а ширину столбца только в символах.

На сайте поддержки офисных приложений Microsoft так написано об этих величинах:

  • высота строки может принимать значение от 0 до 409 пунктов, причем 1 пункт приблизительно равен 1/72 дюйма или 0,035 см;
  • ширина столбца может принимать значение от 0 до 255, причем это значение соответствует количеству символов, которые могут быть отображены в ячейке.

Смотрите, как сделать все ячейки рабочего листа квадратными.

Высота строки

Для изменения высоты строки используйте свойство RowHeight объекта Range. И не важно, будет объект Range представлять из себя выделенный произвольный диапазон, отдельную ячейку, целую строку или целый столбец — высота всех строк, пересекающихся с объектом Range будет изменена после присвоения свойству RowHeight этого объекта нового значения.

Примеры изменения высоты строк:

Пример 1
Изменение высоты отдельной ячейки:

ActiveCell.RowHeight = 10

в результате, строка, в которой находится активная ячейка, приобретает высоту, равную 10 пунктам.

Пример 2
Изменение высоты строки:

в результате, третья строка рабочего листа приобретает высоту, равную 30 пунктам.

Пример 3
Изменение высоты ячеек заданного диапазона:

Range(«A1:D6»).RowHeight = 20

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

Пример 4
Изменение высоты ячеек целого столбца:

Columns(5).RowHeight = 15

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

Ширина столбца

Для изменения ширины столбца используйте свойство ColumnWidth объекта Range. Как и в случае с высотой строки, не важно, будет объект Range представлять из себя выделенный произвольный диапазон, отдельную ячейку, целую строку или целый столбец — ширина всех столбцов, пересекающихся с объектом Range будет изменена после присвоения свойству ColumnWidth этого объекта нового значения.

Примеры изменения ширины столбцов:

Пример 1
Изменение ширины отдельной ячейки:

ActiveCell.ColumnWidth = 15

в результате, столбец, в котором находится активная ячейка, приобретает ширину, равную 15 символам.

Пример 2
Изменение ширины столбца:

Columns(3).ColumnWidth = 50

в результате, третий столбец рабочего листа (столбец «C») приобретает ширину, равную 50 символам.

Пример 3
Изменение ширины ячеек заданного диапазона:

Range(«A1:D6»).ColumnWidth = 25

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

Пример 4
Изменение ширины ячеек целой строки:

в результате, всем столбцам рабочего листа будет назначена ширина, равная 35 символам.

Автоподбор ширины

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

‘запишем для примера в любую ячейку рабочего

‘листа какой-нибудь текст, например, такой:

Cells(5, 5) = «Автоподбор ширины ячейки»

‘теперь подгоним ширину ячейки, а точнее

‘столбца, в котором эта ячейка находится:

Cells(5, 5).EntireColumn.AutoFit

Имейте в виду, что ширина столбца будет подогнана по расположенной в этом столбце ячейке с самым длинным содержимым. Например, если длина содержимого ячейки Cells(7, 5) будет превышать длину содержимого ячейки Cells(5, 5), то автоподбор ширины пятого столбца произойдет по содержимому ячейки Cells(7, 5), несмотря на то, что в строке кода указана другая ячейка.

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

Home / VBA / 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.

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

Range("A1").EntireColumn.AutoFit

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.

Columns(1).AutoFit

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:

Range("A5").EntireRow.AutoFit

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

Rows(5).AutoFit

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.

ActiveSheet.UsedRange.EntireColumn.AutoFit

ActiveSheet.UsedRange.EntireRow.AutoFit

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

Worksheets("Sheet1").UsedRange.EntireColumn.AutoFit
Worksheets("Sheet1").UsedRange.EntireRow.AutoFit

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.

Worksheets("Sheet1").Cells.EntireColumn.AutoFit
Worksheets("Sheet1").Cells.EntireRow.AutoFit

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

With Worksheets("Sheet1").Cells
    .EntireColumn.AutoFit
    .EntireRow.AutoFit
End With

More Tutorials

    • Count Rows using VBA in Excel
    • Excel VBA Font (Color, Size, Type, and Bold)
    • Excel VBA Hide and Unhide a Column or a Row
    • Excel VBA Range – Working with Range and Cells in VBA
    • Apply Borders on a Cell using VBA in Excel
    • Find Last Row, Column, and Cell using VBA in Excel
    • Insert a Row using VBA in Excel
    • Merge Cells in Excel using a VBA Code
    • Select a Range/Cell using VBA in Excel
    • SELECT ALL the Cells in a Worksheet using a VBA Code
    • ActiveCell in VBA in Excel
    • Special Cells Method in VBA in Excel
    • UsedRange Property in VBA in Excel
    • VBA ClearContents (from a Cell, Range, or Entire Worksheet)
    • VBA Copy Range to Another Sheet + Workbook
    • VBA Enter Value in a Cell (Set, Get and Change)
    • VBA Insert Column (Single and Multiple)
    • VBA Named Range | (Static + from Selection + Dynamic)
    • VBA Range Offset
    • VBA Sort Range | (Descending, Multiple Columns, Sort Orientation
    • VBA Wrap Text (Cell, Range, and Entire Worksheet)
    • VBA Check IF a Cell is Empty + Multiple Cells

    ⇠ Back to What is VBA in Excel

    Helpful Links – Developer Tab – Visual Basic Editor – Run a Macro – Personal Macro Workbook – Excel Macro Recorder – VBA Interview Questions – VBA Codes

    Цитата
    cuprum написал:
    Если же высота строки заведомо больше чем нужно,

    можно просто в этом блоке:

    Код
    If OldR_Height < (NewR_Height / ih) Then
        .RowHeight = NewR_Height / ih
    Else
        .RowHeight = OldR_Height
    End If

    оставить только одну строку:

    Код
    .RowHeight = NewR_Height / ih

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

    Код
    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
        Selection.EntireRow.RowHeight = 12.75
        For Each rc In Selection
            RowColHeightForContent rc, bRow
        Next
        Application.ScreenUpdating = True
    End Sub

    еще правильнее делать это только в случае, если в строке есть хоть одна объединенная ячейка. Лень сейчас писать такой код, если честно. Но не сложный — можно просто выдернуть части из предложенных кодов и все.

    Содержание

    1. Подбор высоты строки/ширины столбца объединенной ячейки
    2. VBA Excel. Автоподбор высоты объединенной ячейки
    3. Автоподбор высоты ячейки
    4. Обработка списка ячеек
    5. 12 комментариев для “VBA Excel. Автоподбор высоты объединенной ячейки”
    6. VBA AutoFit (Rows, Column, or the Entire Worksheet)
    7. Key Points
    8. AutoFit a Column
    9. AutoFit a Row
    10. AutoFit UsedRange (Rows and Columns)
    11. AutoFit Entire Worksheet

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

    Для начала немного теории. Если в ячейках листа 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.

    Источник

    Хитрости »

    10 Август 2016              35682 просмотров


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

    Для начала немного теории. Если в ячейках листа 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 < (NewR_Height / ih) Then
                        .RowHeight = NewR_Height / ih
                    Else
                        .RowHeight = OldR_Height
                    End If
                    'возвращаем ширину столбца первой ячейки
                    .Cells(1, 1).EntireColumn.ColumnWidth = OldC_Widht
                Else 'если необходимо изменить ширину столбца
                    .EntireColumn.AutoFit
                    NewC_Widht = .Cells(1).EntireColumn.ColumnWidth    'запоминаем ширину столбца
                    .MergeCells = True
                    If OldC_Widht < (NewC_Widht / iw) Then
                        .ColumnWidth = NewC_Widht / iw
                    Else
                        .ColumnWidth = OldC_Widht
                    End If
                    'возвращаем высоту строки первой ячейки
                    .Cells(1, 1).RowHeight = OldR_Height
                End If
            End With
        End If
    End Function

    Пара замечаний:

    • т.к. нельзя выставить и автоширину и автовысоту — то функция подбирает либо высоту, либо ширину, что логично
    • чтобы подбор по высоте ячеек сработал, для ячейки должен быть выставлен перенос строк(вкладка Главная -группа ВыравниваниеПеренос текста). Если ячеек много и выставлять вручную лень — можно просто убрать апостроф перед точкой в строке:’.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 476 скачиваний)

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


    Статья помогла? Поделись ссылкой с друзьями!

      Плейлист   Видеоуроки


    Поиск по меткам

    

    Access
    apple watch
    Multex
    Power Query и Power BI
    VBA управление кодами
    Бесплатные надстройки
    Дата и время
    Записки
    ИП
    Надстройки
    Печать
    Политика Конфиденциальности
    Почта
    Программы
    Работа с приложениями
    Разработка приложений
    Росстат
    Тренинги и вебинары
    Финансовые
    Форматирование
    Функции Excel
    акции MulTEx
    ссылки
    статистика

    Batosay

    2 / 2 / 1

    Регистрация: 27.01.2014

    Сообщений: 164

    1

    Автоподбор высоты строки в диапазоне

    21.08.2017, 12:34. Показов 18334. Ответов 2

    Метки нет (Все метки)


    Студворк — интернет-сервис помощи студентам

    Добрый день!
    Необходимо сделать следующее:
    Если какой-либо ячейке из диапазона A1:C50 количество символов > 17, то осуществляется автоподбор высоты данной ячейки, а другие остаются без изменения.

    Для одной ячейки я знаю как сделать, а как просматривать все ячейки в диапазоне?

    Код для одной ячейки:

    Visual Basic
    1
    2
    3
    4
    5
    6
    
         If Len(WorkSheet.Cells(1, 1).Value) > 17 Then
            WorkSheet.Cells(1, 1).Select
            With Selection
               .Rows.AutoFit
            End With
    End If



    0



    Vlad999

    3827 / 2254 / 751

    Регистрация: 02.11.2012

    Сообщений: 5,930

    21.08.2017, 13:20

    2

    Лучший ответ Сообщение было отмечено Batosay как решение

    Решение

    как вариант

    Visual Basic
    1
    2
    3
    4
    
    Dim M as Range
    For each M in Range("A1:C50")
      If Len(M) > 17 Then  M.Rows.AutoFit
    next

    Добавлено через 3 минуты
    вариант 2, так лучше не будет лишних переборов.

    Visual Basic
    1
    2
    3
    4
    5
    
    For i=1 To 50
        For j=1 To 3
            If Len(cells(i,j))>17 Then Cells(i,j).Rows.AutoFit: exit for
        next
    next



    0



    pashulka

    4131 / 2235 / 940

    Регистрация: 01.12.2010

    Сообщений: 4,624

    21.08.2017, 14:29

    3

    Два альтернативных варианта, где перебираются только строки :

    Visual Basic
    1
    2
    3
    4
    
    Dim r As Range, t$: t = String(18, "?") & "*"
    For Each r In [A1:C50].Rows
        If Application.CountIf(r, t) > 0 Then r.AutoFit
    Next
    Visual Basic
    1
    2
    3
    4
    
    Dim r As Range, t$: t = String(18, "?") & "*"
    For Each r In Range("A1:C50").Rows
        If Not r.Find(t, , xlValues) Is Nothing Then r.AutoFit
    Next



    0



    Содержание

    • Установить ширину столбца с помощью VBA
    • Установить высоту строки с помощью VBA
    • Ширина столбца автозаполнения
    • Автоподбор высоты строки
    • Установить ширину ячейки
    • Установить высоту ячейки
    • Получить ширину столбца
    • Получить высоту строки

    В этом руководстве будет показано, как установить высоту строки и ширину столбца с помощью VBA.

    Высоту строк и ширину столбцов Excel можно изменить в VBA, задав свойства .RowHeight и .ColumnWidth.

    Макрос для установки ширина колонки столбцов от A до E:

    123 Sub Column_Width ()Столбцы («A: E»). Ширина столбца = 30Конец подписки

    Установить высоту строки с помощью VBA

    Макрос для установки высота строки строки 1:

    123 Sub RowHeight ()Ряды («1: 1»). RowHeight = 30Конец подписки

    Ширина столбца автозаполнения

    Excel предлагает возможность «Автозаполнения» ширины столбцов. Эта функция регулирует ширину столбца так, чтобы столбцы были достаточно широкими, чтобы вместить весь текст, найденный в этом столбце.

    Чтобы автоматически подогнать ширину столбцов в VBA:

    1 Столбцы («A: B»). Автоподбор

    Мы писали больше об этом в другой статье о том, как автоматически подогнать столбец из VBA, в том числе о том, как автоматически подогнать все используемые столбцы.

    Автоподбор высоты строки

    Вы также можете автоматически подогнать высоту строк, используя аналогичный метод:

    1 Ряды («1: 2»). Автоподбор

    Установить ширину ячейки

    Вы также можете настроить ширину столбца, указав ячейку:

    1 Диапазон («a1»). CompleteColumn.ColumnWidth = 20

    Установить высоту ячейки

    Или отрегулируйте высоту строки, указав ячейку:

    1 Диапазон («a1»). CompleteRow.RowHeight = 10

    Получить ширину столбца

    Чтобы получить ширину столбца столбца:

    12 dim iColumnWidth до тех пор, покаiColumnWidth = columns («a»). ColumnWidth

    Примечание. Это вернет Null, если все столбцы в диапазоне не имеют одинаковой ширины.

    Получить высоту строки

    Точно так же вы можете получить высоту строки:

    12 dim iRowHeight до тех пор, покаiRowHeight = rows («1»). RowHeight

    Вы поможете развитию сайта, поделившись страницей с друзьями

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

    kyznezov3003

    Дата: Четверг, 22.08.2019, 10:05 |
    Сообщение № 1

    Группа: Пользователи

    Ранг: Прохожий

    Сообщений: 8


    Репутация:

    0

    ±

    Замечаний:
    0% ±


    Excel 2016

    Здравствуйте, встретил макрос на просторах сети с автоподбором высоты строки, частично изменил что бы не оставалось лишнее поле, но не могу найти где можно настроить что бы не выделять диапазон, необходимо что бы редактировало например ячейки A1:O29 на листе 1 и на листе 2 A1:O20 и работало с ними, а не в ручную выделять необходимый диапазон

    К сообщению приложен файл:

    1811693.xls
    (72.5 Kb)

    Сообщение отредактировал kyznezov3003Четверг, 22.08.2019, 10:23

     

    Ответить

    kyznezov3003

    Дата: Четверг, 22.08.2019, 10:06 |
    Сообщение № 2

    Группа: Пользователи

    Ранг: Прохожий

    Сообщений: 8


    Репутация:

    0

    ±

    Замечаний:
    0% ±


    Excel 2016

    Если есть возможность то прошу в ячейке Exel написать код и отметить красным что нужно менять

     

    Ответить

    Nic70y

    Дата: Четверг, 22.08.2019, 11:33 |
    Сообщение № 3

    Группа: Друзья

    Ранг: Экселист

    Сообщений: 8134


    Репутация:

    1998

    ±

    Замечаний:
    0% ±


    Excel 2010

    рекордер сказал:
    [vba]

    Код

    Sub U_729()
        Sheets(«Лист1»).Rows(«1:29»).Rows.AutoFit
        Sheets(«Лист2»).Rows(«1:20»).Rows.AutoFit
    End Sub

    [/vba]


    ЮMoney 41001841029809

     

    Ответить

    kyznezov3003

    Дата: Четверг, 22.08.2019, 14:25 |
    Сообщение № 4

    Группа: Пользователи

    Ранг: Прохожий

    Сообщений: 8


    Репутация:

    0

    ±

    Замечаний:
    0% ±


    Excel 2016

    Спасибо за совет, возможно криво но вроде сделал, вот код с исправлениями добавляются значения «Sheets(«Лист2»).Select и Range(«C16:F18″).Select», но вот возникла проблема что автопоставка размера по выделенным ячейкам происходит только на одном листе, можете что-либо посоветовать?
    [vba]

    Код

    Option Explicit

    Sub ChangeRowColHeight()
    Dim rc As Range
    Dim bRow As Boolean
    bRow = (MsgBox(«Изменять высоту строк?», vbQuestion + vbYesNo, «») = vbYes)
    ‘bRow = True: для изменения высоты строк
    ‘bRow = False: для изменения ширины столбцов
    Sheets(«Лист1»).Select
    Range(«C16:F18»).Select
    Sheets(«Лист2»).Select
    Range(«C16:F18»).Select
    Application.ScreenUpdating = False
    For Each rc In Selection
    RowColHeightForContent rc, bRow
    Next
    Application.ScreenUpdating = True
    End Sub
    ‘—————————————————————————————
    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 = 1
    For Each CurrCell In .Columns
    MergedC_Widht = CurrCell.ColumnWidth + MergedC_Widht
    Next
    ‘запоминаем высоту и ширину первой ячейки из объединенных
    OldR_Height = .Cells(0, 0).RowHeight
    OldC_Widht = .Cells(1, 1).ColumnWidth
    ‘отмеяем объединение ячеек
    .MergeCells = False
    ‘назначаем новую высоту и ширину для первой ячейки
    .Cells(0).RowHeight = MergedR_Height
    .Cells(1, 1).EntireColumn.ColumnWidth = MergedC_Widht
    ‘если необходимо изменить высоту строк
    If bRowHeight Then
    .EntireRow.AutoFit
    NewR_Height = .Cells(1).RowHeight ‘запоминаем высоту строки
    .MergeCells = True
    If OldR_Height < (NewR_Height / ih) Then
    .RowHeight = NewR_Height / ih
    Else
    .RowHeight = OldR_Height
    End If
    ‘возвращаем ширину столбца первой ячейки
    .Cells(1, 1).EntireColumn.ColumnWidth = OldC_Widht
    Else ‘если необходимо изменить ширину столбца
    .EntireColumn.AutoFit
    NewC_Widht = .Cells(1).EntireColumn.ColumnWidth ‘запоминаем ширину столбца
    .MergeCells = True
    If OldC_Widht < (NewC_Widht / iw) Then
    .ColumnWidth = NewC_Widht / iw
    Else
    .ColumnWidth = OldC_Widht
    End If
    ‘возвращаем высоту строки первой ячейки
    .Cells(1, 1).RowHeight = OldR_Height
    End If
    End With
    End If
    End Function

    [/vba]

    Сообщение отредактировал kyznezov3003Четверг, 22.08.2019, 14:49

     

    Ответить

    китин

    Дата: Четверг, 22.08.2019, 14:31 |
    Сообщение № 5

    Группа: Модераторы

    Ранг: Экселист

    Сообщений: 6973


    Репутация:

    1063

    ±

    Замечаний:
    0% ±


    Excel 2007;2010;2016

    kyznezov3003, — Оформите код тегами (в режиме правки поста выделите код и нажмите кнопку #, пояснялка здесь)


    Не судите очень строго:я пытаюсь научиться
    ЯД 41001877306852

     

    Ответить

    kyznezov3003

    Дата: Четверг, 22.08.2019, 14:48 |
    Сообщение № 6

    Группа: Пользователи

    Ранг: Прохожий

    Сообщений: 8


    Репутация:

    0

    ±

    Замечаний:
    0% ±


    Excel 2016

    китин, Изменил, спасибо за совет, можете подсказать по поводу кода? Может что то нужно добавить?

    Сообщение отредактировал kyznezov3003Четверг, 22.08.2019, 14:49

     

    Ответить

    Nic70y

    Дата: Четверг, 22.08.2019, 14:59 |
    Сообщение № 7

    Группа: Друзья

    Ранг: Экселист

    Сообщений: 8134


    Репутация:

    1998

    ±

    Замечаний:
    0% ±


    Excel 2010

    в модуль листа 1
    [vba]

    Код

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range(«a1:o29»)) Is Nothing Then
            Rows(«1:29»).Rows.AutoFit
        End If
    End Sub

    [/vba]
    в модуль лита 2
    [vba]

    Код

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range(«a1:o20»)) Is Nothing Then
            Rows(«1:20»).Rows.AutoFit
        End If
    End Sub

    [/vba]

    К сообщению приложен файл:

    7699737.xlsm
    (17.4 Kb)


    ЮMoney 41001841029809

     

    Ответить

    kyznezov3003

    Дата: Четверг, 22.08.2019, 15:50 |
    Сообщение № 8

    Группа: Пользователи

    Ранг: Прохожий

    Сообщений: 8


    Репутация:

    0

    ±

    Замечаний:
    0% ±


    Excel 2016

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

    К сообщению приложен файл:

    5397454.xls
    (68.5 Kb)

    Сообщение отредактировал kyznezov3003Четверг, 22.08.2019, 16:43

     

    Ответить

    Nic70y

    Дата: Четверг, 22.08.2019, 16:52 |
    Сообщение № 9

    Группа: Друзья

    Ранг: Экселист

    Сообщений: 8134


    Репутация:

    1998

    ±

    Замечаний:
    0% ±


    Excel 2010

    не используйте объединенные ячейки


    ЮMoney 41001841029809

     

    Ответить

    kyznezov3003

    Дата: Четверг, 22.08.2019, 17:04 |
    Сообщение № 10

    Группа: Пользователи

    Ранг: Прохожий

    Сообщений: 8


    Репутация:

    0

    ±

    Замечаний:
    0% ±


    Excel 2016

    Nic70y, А не подскажете по поводу того что автоматическая высота ставится на 2-ом листе, но на первом не изменяется, как с этим справиться?

     

    Ответить

    Nic70y

    Дата: Четверг, 22.08.2019, 17:14 |
    Сообщение № 11

    Группа: Друзья

    Ранг: Экселист

    Сообщений: 8134


    Репутация:

    1998

    ±

    Замечаний:
    0% ±


    Excel 2010

    о каком файле речь?
    у меня изменяется, только все строки становятся = по умолчанию (т.к. там есть объединенные ячейки)


    ЮMoney 41001841029809

     

    Ответить

    kyznezov3003

    Дата: Четверг, 22.08.2019, 17:31 |
    Сообщение № 12

    Группа: Пользователи

    Ранг: Прохожий

    Сообщений: 8


    Репутация:

    0

    ±

    Замечаний:
    0% ±


    Excel 2016

    Nic70y, Про этот файл идет речь, там вставлены макросы по вашему совету, но на 1-ом листе при запуске макроса не выставляет автоматически высоту строки, то есть он работает строго на 2-ом листе, пропуская 1-ый лист. Получается он на первый лист даже по умолчанию не ставит высоту строки

    Сообщение отредактировал kyznezov3003Четверг, 22.08.2019, 17:43

     

    Ответить

    Nic70y

    Дата: Пятница, 23.08.2019, 16:28 |
    Сообщение № 13

    Группа: Друзья

    Ранг: Экселист

    Сообщений: 8134


    Репутация:

    1998

    ±

    Замечаний:
    0% ±


    Excel 2010

    если особо не вникать (править) в код
    [vba]

    Код

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range(«a16:o29»)) Is Nothing Then
            Target.Select
            Call ChangeRowColHeight
        End If
    End Sub

    [/vba]
    [vba]

    Код

    Sub ChangeRowColHeight()
        Dim rc As Range
        Application.ScreenUpdating = False
        For Each rc In Selection
            RowColHeightForContent rc
        Next
        Application.ScreenUpdating = True
    End Sub

    [/vba]

    К сообщению приложен файл:

    1277014.xls
    (64.5 Kb)


    ЮMoney 41001841029809

     

    Ответить

    kyznezov3003

    Дата: Пятница, 23.08.2019, 21:36 |
    Сообщение № 14

    Группа: Пользователи

    Ранг: Прохожий

    Сообщений: 8


    Репутация:

    0

    ±

    Замечаний:
    0% ±


    Excel 2016

    Nic70y, Не помогло, в любом случае точно такая же проблема, работает на одной, но не работает на другой, но придумал как решить проблему, просто несколько макросов добавлю на каждую страницу отдельно, сделаю выносками, спасибо за помощь)))

     

    Ответить

    Понравилась статья? Поделить с друзьями:
  • Vba excel union range
  • Vba excel workbook protect
  • Vba excel автонумерация строк
  • Vba excel webbrowser control
  • Vba excel type массив