vba Excel自动调整合并单元格的高度

Excel adjust height of merged cells automatically

提问by MarMarko

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:

我在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

结束子

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

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

回答by Tim Williams

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

回答by steve_cdi

There is a much easier way of doing this if you allow the Excel sheet to do some of the heavy lifting for you.

如果您允许 Excel 工作表为您完成一些繁重的工作，则有一种更简单的方法可以做到这一点。

The following example works in the common scenario that you have some cells that comprise several columns but only a single row (i.e. some columns are merged together on a single row). The usual problem is that the row height for wrapped text in the merged cell does not accomodate the height of the wrapped text in some circumstances (e.g. the result of a formula or database lookup gives a large and varying amounts of text)

以下示例适用于您有一些单元格包含多列但只有一行（即某些列合并为一行）的常见情况。通常的问题是合并单元格中换行文本的行高在某些情况下不适应换行文本的高度（例如，公式或数据库查找的结果给出了大量且不同数量的文本）

To solve this, simulate single celled versions of the merged cells by doing the following in some columns that are not visible to the user:

要解决此问题，请通过在用户不可见的某些列中执行以下操作来模拟合并单元格的单单元格版本：

1. In a single cell that is on the same row as the merged cell, place an identical formulae or simply set the formulae equal to a reference to the merged cell.
2. Do this for all merged cells.
3. Make the width of the single cell versions equal to the width of each merged cell(s). You now have a set of single celled versions of the merged cells, on the same rows, but with the same column width.
4. Name these single cells.

5. Write a function that loops through all of these named single cell ranges and calls the following function for each:

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

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
   

回答by Mr.Dzou

What about this:

那这个呢：

'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