修复'Auto Fit Row Height Of Merged Cells'公式的代码请求。VBA Excel

Question

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

从源源上的线程（下面列出），对该问题没有任何真正令人满意的解决方案。

合并的单元从多个来源获取信息，其中包括'char（10）空间，使得很难为自动拟合创建单个单元格列。

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-height-merged-cells.html?page_comment=2

Answer 1

尝试添加下面的行：

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

之后：

oRange.MergeCells = True
oRange.WrapText = True

在上面的代码中