Автоподбор высоты объединённых ячеек

Предлагаю 2 варианта автоподбора высоты объединённых ячеек в Excel
(оба работаю не идеально, - но, тем не менее, в большинстве случаев и этого будет достаточно)

1 вариант: (разъединение, автоподбор, объединение)

Sub AutoFitMergeAreaSize(ByRef cell As Range)
    Dim ra As Range: Set ra = cell.MergeArea
    cell.UnMerge
    cell.EntireRow.AutoFit
    ra.Merge
End Sub
 
Sub ПримерИспользования_АвтоподборВысотыОбъединённойЯчейки()
    AutoFitMergeAreaSize ActiveCell
    AutoFitMergeAreaSize [d3]
End Sub

2 вариант:(то же самое, по сути, только кода побольше)

Sub AutoFitMergedCellRowHeight(ByRef ra As Range)
    Dim CurrCell As Range, cell As Range, ma As Range: Dim col As Range, ro As Range
    For Each ro In ra.Rows
        maxRH = 0
        For Each cell In ro.Cells
            If cell.MergeCells And cell.Address = cell.MergeArea.Cells(1).Address Then
                Debug.Print cell.Address
                Set ma = cell.MergeArea: newCW = 0
                With ma
                    cw = .Columns(1).ColumnWidth: .UnMerge
                    For Each col In .EntireColumn: newCW = newCW + col.ColumnWidth: Next
                    .Columns(1).ColumnWidth = newCW: .EntireRow.AutoFit
                    rh = .EntireRow.RowHeight: If rh > maxRH Then maxRH = rh
                    .Merge: .Columns(1).ColumnWidth = cw
                End With
            End If
        Next cell
        If maxRH > 0 Then ro.EntireRow.RowHeight = maxRH
    Next ro
End Sub
 
Sub ПримерИспользования()
    Application.ScreenUpdating = False
    AutoFitMergedCellRowHeight [a2:z8]
End Sub

30105 просмотров

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Евгений, 15 Ноя 2017 - 18:34.#1

Подскажите пожалуйста, как второй вариант сделать автозапускаемым после заполнения ячейки к примеру С8 и С9 информацией (текст), ячейки объединенные по строке, диапазон с8:p9 (строки 8 и 9, объединены с c:p)

Abtlt, 22 Сен 2016 - 21:35.#2

Пример()
AutoFitMergeAreaSize ActiveCell
AutoFitMergeAreaSize [d3]
End Sub
А если нужно обратится к ячейке с другого листа? Как быть?

Гость, 7 Апр 2016 - 17:30.#3

Вы достойный человек! Спасибо :)

nerv, 10 Окт 2011 - 14:20.#4

>>Тогда надо бы, наверное, в варианте 2 на этой странице подправить:
вместо rh = .EntireRow.RowHeight
написать rh = .Item(1).RowHeight

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

Ув. EducatedFool, Ваш пример http://excelvba.ru/XL_Files/Sample__30-07-2011__15-31-17.zip лечится обратным проходом по строкам.

Alex_ST, 10 Окт 2011 - 13:59.#5

Спасибо за ответ. Я уже на Планете в том топике посмотрел и всё понял: возвращается высота не одной строки, а нескольких.
Тогда надо бы, наверное, в варианте 2 на этой странице подправить:
вместо rh = .EntireRow.RowHeight
написать rh = .Item(1).RowHeight

nerv, 10 Окт 2011 - 13:34.#6

Ответ на Планете : )

http://www.planetaexcel.ru/forum.php?thread_id=23911&page_forum=3&allnum...

Игорь (администратор сайта), 10 Окт 2011 - 13:03.#7

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

Alex_ST, 10 Окт 2011 - 12:20.#8

Никак не могу разобраться почему если объединены ячейки ОДНОЙ строки, то второй макрос срабатывает нормально, а если объединены ячейки по вертикали, то после выполнения подбора высоты командой .EntireRow.AutoFit
диапазон .EntireRow становится = Nothing и, естественно, присвоение rh = .EntireRow.RowHeight вылетает по ошибке?

Автоподбор высоты объединённых ячеек

Комментарии

Настройки просмотра комментариев

Отправить комментарий

НАДСТРОЙКИ ДЛЯ EXCEL