Excel VBA自动调整合并单元格

亲爱的Stackoverflow用户：

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

我在“extendoffice.com”上找到了以下代码。 （）

代码看起来很干净很好，但是我不能让它正常工作，我认为这是由于列的大小不同造成的。 高度总是非常大

我已经试着得到一个常数，将结果除以2或其他因子，但这不起作用

你能不能帮我看看，并给我一些指导，如何解决我遇到的这个问题，即高度远远大于必要的高度

示例文件：

守则：

    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

所以我按照艾伦·怀亚特的建议尝试了一下

他建议使用一个helper列，在我的例子中是p列（不应该紧邻），并且有一个格式相同的单元格（除了合并）指向合并区域的左上角单元格

因此，如果在合并范围内有以下内容

B4:K4

：

最初是这样压缩的：

在

P4

中输入公式

=B4

然后在一个标准模块中放入

Option Explicit

Sub Autofit()

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

End Sub

---

似乎有效。

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

我为多个合并单元格的自动调整行高制作了附加模块。 如果要自动调整行高，请使用此选项。 [发布版本2.6·toowaki/AutoFitRowEx·GitHub]

---

本文建议使用一个帮助器列，其中有一个单元格指向合并区域左上角的单元格，并且使用该列进行设置。请不要链接到代码。在答案中填入相关代码。如果在P4中填入公式不起作用，请加上A4