Excel автоматически регулирует высоту объединенных ячеек

Question

У меня есть небольшая проблема в excel. Я не знаком с макросами excel и буду благодарен за помощь. Я пытаюсь найти макрос, который выравнивает высоту объединенной ячейки, чтобы соответствовать ее контенту. автоматически. Я нашел кое-что, с которым могли бы сделать, что для ячеек в нескольких столбцах, но не для нескольких строк, а также не автоматически:

Sub AutoFitMergedCellRowHeight() 
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single 
Dim CurrCell As Range 
Dim ActiveCellWidth As Single, PossNewRowHeight As Single 
Dim iX As Integer 

If ActiveCell.MergeCells Then 
    With ActiveCell.MergeArea 
     If .Rows.Count = 1 And .WrapText = True Then 
      Application.ScreenUpdating = False 
      CurrentRowHeight = .RowHeight 
      ActiveCellWidth = ActiveCell.ColumnWidth 
      For Each CurrCell In Selection 
       MergedCellRgWidth = CurrCell.ColumnWidth + _ 
        MergedCellRgWidth 
       iX = iX + 1 
      Next 
      MergedCellRgWidth = MergedCellRgWidth + (iX - 1) * 0.71 
      .MergeCells = False 
      .Cells(1).ColumnWidth = MergedCellRgWidth 
      .EntireRow.AutoFit 
      PossNewRowHeight = .RowHeight 
      .Cells(1).ColumnWidth = ActiveCellWidth 
      .MergeCells = True 
      .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _ 
       CurrentRowHeight, PossNewRowHeight) 
     End If 
    End With 
End If 

End Sub

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

Answer 1

Что-то вроде:

Dim h, rng As Range 
Set rng = Selection 

With rng 
    .UnMerge 
    .Cells(1).EntireRow.AutoFit 
    h = .Cells(1).RowHeight 
    .Merge 
    .EntireRow.AutoFit 
    With .Cells(1).MergeArea 
     .Cells(.Cells.Count).RowHeight = _ 
      .Cells(.Cells.Count).RowHeight + (h - .Height) 
    End With 
End With 

Answer 2

Существует гораздо более простой способ сделать это, если вы позволяете лист Excel, чтобы сделать некоторые тяжелую для вас.

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

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

1. в одной ячейке, которая находится на той же строке, объединенную ячейку, поместите идентичные формулы или просто устанавливают формулы, равные ссылке на объединенную ячейку.
2. Сделайте это для всех объединенных ячеек.
3. Сделайте ширину одиночных версий ячеек равными ширине каждой объединенной ячейки (ячеек). Теперь у вас есть набор одноячеистых версий объединенных ячеек в тех же строках, но с одинаковой шириной столбца.
4. Назовите эти отдельные ячейки.

5. Написать функцию, которая перебирает все этих названные одиночных диапазонов ячеек и вызывает следующую функцию для каждого:

   Private Sub AutosizeLongFormInput(rng As Range) 
       If Not rng.EntireRow.Hidden = True Then 
        rng.EntireRow.AutoFit 
       End If 
   End Sub