Excel自动调整合并单元格的高度 [英] Excel adjust height of merged cells automatically

问题描述

我在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 
 
如果ActiveCell.MergeCells然后
与ActiveCell.MergeArea 
如果.Rows.Count = 1和.WrapText = True然后
 Application.ScreenUpdating = False 
 CurrentRowHeight = .RowHeight 
 ActiveCellWidth = ActiveCell.ColumnWidth 
对于每个CurrCell在选择
 MergedCellRgWidth = CurrCell.ColumnWidth + _ 
 MergedCellRgWidth 
 iX = iX + 1 
下一个
 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>如果
结束如果
结束如果
  

End Sub

最终结果应如下所示：
提前谢谢。

解决方案

  Dim h，rng As Range 
设置rng =选择
 
带rng 
 .UnMerge 
 .Cells（1）.EntireRow.AutoFit 
h = .Cells（1）.RowHeight 
 .Merge 
 .EntireRow.AutoFit 
带有.Cells （1）.MergeArea 
 .Cells（.Cells.Count）.RowHeight = _ 
 .Cells（.Cells.Count）.RowHeight +（h  -  .Height）
结束
结束
  

I have a little problem in excel. I not experienced with excel macros and would be grateful for some help. I am trying to find a macro which ajustes the height of a merged cell to fit its content. automatically. I found something with which could do that for cells in several columns but not for several rows and also not automatically:

 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

The end result should look like this: Thank you in advance.

解决方案

Something like:

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

这篇关于Excel自动调整合并单元格的高度的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！