Excel自动调整合并单元格行高

自动调整合并单元格行高原型

原理是：

因为独立单元格设置了自动换行后，高度会自动变化，利用这个特点，将合并单元格的内容复制到一个独立单元格，并将这个单元格格式设置成自动换行，且其宽度设置为合并区域宽度(合并区域宽度=合并区域中各列宽度之和)，再将此时独立单元格的行高值设置到合并区域所在的行即可。

运行条件：创建一个名字为temp的Sheet表单,将下内容粘贴到Excel模块中。

VBA程序如下：

Sub main()

MergeCellAutoFit "sheet1", 6, 2

End Sub

Sub MergeCellAutoFit(sSheet As String, mRow As Integer, mCol As Integer)

Dim mWidth As Double

Dim mSt, mEd As Integer

If Sheets(sSheet).Cells(mRow, mCol).MergeCells Then

mSt = Sheets(sSheet).Cells(mRow, mCol).MergeArea.Column

mEd = mSt + Sheets(sSheet).Cells(mRow, mCol).MergeArea.Columns.Count() - 1

For i = mSt To mEd

mWidth = mWidth + Sheets(sSheet).Columns(i).ColumnWidth

Next i

Sheets("temp").Columns(1).ColumnWidth = mWidth + (mEd - mSt) * 0.6

With Sheets("temp").Range("A1")

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlTop

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Sheets(sSheet).Cells(mRow, mCol).Copy

Sheets("temp").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Sheets(sSheet).Rows(mRow).RowHeight = Sheets("temp").Rows(1).RowHeight

Sheets("temp").Columns(1).Delete

Else

MsgBox "不是合并单元格！" End If

End Sub