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
   

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

Answer 3

这个怎么样：

'rRang is range of cells which are merged together

Sub AutoFitRowMergedCells(rRang As Range)

Dim iColW As Integer, iColWold As Integer, I As Integer

iColW = 0

For I = 1 To rRang.Columns.Count
    iColW = iColW + rRang.Range("A" & I).ColumnWidth
Next I

rRang.UnMerge
iColWold = rRang.Range("A1").ColumnWidth
rRang.Range("A1").ColumnWidth = iColW
rRang.Range("A1").EntireRow.AutoFit
rRang.Range("A1").ColumnWidth = iColWold
rRang.Merge

End Sub