修復了“自動調整合並單元格的行高”公式的代碼請求。 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-merged-cells.html?page_comment=2

Answer 1

嘗試添加以下行：

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

后：

oRange.MergeCells = True
oRange.WrapText = True

在上面的代碼中