Question

此宏的主要问题是，当文本太长时，合并单元格的高度会变得太大。

来自源代码的线程（如下所列），对该问题没有任何令人满意的解决方案。

合并的单元格从多个来源获取信息，并包含“＃（9）”空格，这使得难以为自动拟合创建单个单元格列。

Option Explicit
Public Sub AutoFitAll()
  Call AutoFitMergedCells(Range("a1:b2"))
   Call AutoFitMergedCells(Range("c4:d6"))
    Call AutoFitMergedCells(Range("e1:e3"))
End Sub

Public Sub AutoFitMergedCells(oRange As Range)
  Dim tHeight As Integer
  Dim iPtr As Integer
  Dim oldWidth As Single
  Dim oldZZWidth As Single
  Dim newWidth As Single
  Dim newHeight As Single
  With Sheets("Sheet4")
    oldWidth = 0
    For iPtr = 1 To oRange.Columns.Count
      oldWidth = oldWidth + .Cells(1, oRange.Column + iPtr - 1).ColumnWidth
    Next iPtr
    oldWidth = .Cells(1, oRange.Column).ColumnWidth + .Cells(1, oRange.Column + 1).ColumnWidth
    oRange.MergeCells = False
    newWidth = Len(.Cells(oRange.Row, oRange.Column).Value)
    oldZZWidth = .Range("ZZ1").ColumnWidth
    .Range("ZZ1") = Left(.Cells(oRange.Row, oRange.Column).Value, newWidth)
    .Range("ZZ1").WrapText = True
    .Columns("ZZ").ColumnWidth = oldWidth
    .Rows("1").EntireRow.AutoFit
    newHeight = .Rows("1").RowHeight / oRange.Rows.Count
    .Rows(CStr(oRange.Row) & ":" & CStr(oRange.Row + oRange.Rows.Count - 1)).RowHeight = newHeight
    oRange.MergeCells = True
    oRange.WrapText = True
    .Range("ZZ1").ClearContents
    .Range("ZZ1").ColumnWidth = oldZZWidth
  End With
End Sub

来源：https://www.extendoffice.com/documents/excel/2342-excel-autofit-row-height-merged-cells.html?page_comment=2

Answer 1

尝试添加以下行：

oRange.Rows(oRange.Rows.Count).EntireRow.AutoFit

后：

oRange.MergeCells = True
oRange.WrapText = True

在上面的代码中

修复合并单元格的自动调整行高的代码请求＆＃39;式。 VBA Excel

1 个答案: