Excel VBA自动调整合并单元格

Question

亲爱的Stackoverflow用户，

对于项目，我想调整合并行的高度以适合内容。

我在＆＃34; extendoffice.com＆＃34;上找到了以下代码。 （https://www.extendoffice.com/documents/excel/2342-excel-autofit-row-height-merged-cells.html?page_comment=3）

代码看起来干净整洁，但我无法正常工作，我认为这是由于列的大小不同而造成的。 高度总是很大。

我已经试图获得一个常数来将结果除以2或其他因素，但这不起作用。

你能看看并给我指导如何解决这个问题我遇到的高度比必要的高。

示例文件： Example File

守则：

    Option Explicit

Public Sub AutoFitAll()

  Call AutoFitMergedCells(Range("B4:K4"))
  Call AutoFitMergedCells(Range("B5:K5"))
  Call AutoFitMergedCells(Range("B6:K6"))

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("Lead")
    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

提前致谢！

此致 Dubblej

Answer 1

所以我根据Allen Wyatt的建议here试了一下。

他建议使用辅助列，在我的例子中，列P（不应该是紧邻的）并且有一个格式相同的单元格（合并除外）指向合并范围的左上角单元格。

因此，如果您在合并范围B4:K4中有以下内容：

最初被压缩的是：

在P4中输入公式=B4

然后在标准模块中放

Option Explicit

Sub Autofit()

    ActiveSheet.Range("P4").Rows.Autofit

End Sub

似乎工作。

Answer 2

这个问题似乎很简单，但您可以看到有几个例外情况可供使用。实际上必要的代码是简单代码大小的10倍。

我为多个合并单元格的自动调整行高度添加了加载项。 如果你想自动调整行高，请使用它。 [发布Ver2.6·toowaki / AutoFitRowEx·GitHub] https://github.com/toowaki/AutoFitRowEx/releases/tag/2.6.2