调整Excel合并自动换行单元格行高的VBA代码失效问题

原代码仅固定增加行高数值，无法根据合并单元格内的实际文本行数动态调整行高。以下是满足需求的修正方案：

修正后的VBA代码 #

Sub SetRowHeightByTextLines()
    Dim ws As Worksheet
    Dim targetRow As Range
    Dim mergedCell As Range
    Dim singleLineHeight As Double
    Dim textLines As Integer
    Dim maxRowHeight As Double
    
    Set ws = Sheets(1)
    singleLineHeight = ws.StandardHeight ' 获取工作表默认单行高度
    maxRowHeight = 409.5 ' Excel允许的最大行高
    
    ' 遍历B4到B8对应的行
    For Each targetRow In ws.Range("B4:B8").Rows
        ' 获取当前行的合并单元格区域（以B列单元格为合并区域起点）
        Set mergedCell = targetRow.Cells(1).MergeArea
        
        ' 开启自动换行确保文本行数计算准确
        mergedCell.WrapText = True
        ' 通过单元格实际高度除以单行高度，计算文本行数
        textLines = Round(mergedCell.Height / singleLineHeight, 0)
        
        ' 计算目标行高，不超过最大值限制
        Dim targetHeight As Double
        targetHeight = singleLineHeight * textLines
        If targetHeight > maxRowHeight Then
            targetHeight = maxRowHeight
        End If
        
        ' 设置最终行高
        targetRow.RowHeight = targetHeight
    Next targetRow
End Sub

关键逻辑说明 #

• 基准高度获取：ws.StandardHeight直接读取当前工作表的默认单行高度，作为倍数计算的基准
• 文本行数计算：开启自动换行后，通过合并单元格的实际高度除以单行高度，得到准确的文本占用行数
• 边界处理：加入Excel最大行高409.5的限制，避免设置超出范围的行高

内容的提问来源于stack exchange，提问作者Prabhat Vishwas