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

Макрос для настройки высоты строки, в которой есть объединённые ячейки

Если вопрос не решается стандартными средствами, его можно решить макросами. Всегда, если есть техническая закономерность. Все использованные команды изучаются на курсе Excel-XL: Макросы VBA Excel с нуля (24 ак.ч.)

Автоподбор высоты строки, в которой есть объединённая ячейка, НЕ РАБОТАЕТ. И чаще всего Вы вручную настраиваете высоту таких строк. Никакой экспертной работы и развития, одна рутина... ((

PowerQuery тут тоже не поможет. А вот макрос – он как всемогущий Джинн :)

Я сделала своим макросом вот что:

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

2 - Выполнила автоподбор штатной командой, никаких расчётов – всё будет так, как сделает сам Excel!

3 - Получившуюся высоту строку устанавливаю для строки-оригинала. Идеально!

Теперь чувствую себя самой хитрой.

Должна, конечно, предупредить, что остаётся ошибка, когда даже при ручном автоподборе высота строки может получиться несколько больше, чем нужно (вверху образуется пустота), но это внутренняя ошибка Excel и с ней я ничего не могу сделать. В такой случае я, как правило, делаю немного шире исходные столбцы и повторяю макрос. Чаще всего это решает проблему.

По уровню сложности такой макрос можно написать после моего курса «МАКРОСЫ НА VBA С НУЛЯ».

Код макроса:

'макрос работает по заранее выделенному пользователем диапазону
Sub AutofitRowHeightWithMerge()
Application.DisplayAlerts = False

Selection.WrapText = True 'включить перенос текста в ячейках

'запомнить текущий лист
Set sh1 = ActiveWorkbook.ActiveSheet
'Сделать копию листа
ActiveSheet.Copy: Set Sh2 = ActiveWorkbook.ActiveSheet

nc = Selection.Columns.Count 'кол-во столбцов в выделении
nc1 = Selection.Column 'номер первого столбца в выделении
nc2 = nc1 + nc - 1 'номер последнего столбца в выделении

nr = Selection.Rows.Count 'кол-во строк в выделении
nr1 = Selection.Row 'номер первой строки в выделении
nr2 = nr1 + nr - 1 'номер последней строки в выделении

'сумма ширин всех столбцов в выделении
For i = nc1 To nc2
wc = wc + Columns(i).ColumnWidth
Next
'Debug.Print wc

Selection.UnMerge 'отменить объединённые ячейки
Columns(nc1).ColumnWidth = wc

If wc > 254.86 Then
MsgBox "Слишком много столбцов! Общая ширина выделения должна быть не более 254,86!", vbCritical
Application.DisplayAlerts = True
Exit Sub
End If

For i = nr1 To nr2

Rows(i).AutoFit 'автоподбор высоты строки
rh = Rows(i).RowHeight 'записать получившуюся высоту строки
'если ниже пусто, считать кол-во пустых строк
Do While Cells(i + 1 + q, nc1) = "" And i + 1 + q <= nr2
q = q + 1
Loop

If q = 0 Then
rh = rh
Else: rh = rh / (1 + q) '(разделить высоту на получившееся число строк)
End If
If rh > 409 Then
MsgBox "Получается слишком большая высота строки! Я умею настраивать максимум 409!", vbCritical
Application.DisplayAlerts = True
Exit Sub
End If

sh1.Rows(i).Resize(1 + q).RowHeight = rh

i = i + q 'пересчёт номера i
q = 0 'очистка переменной
Next i

ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub

Обратите внимание: для автоподбора выделяются ЯЧЕЙКИ, НЕ СТРОКИ, это важно.