如何基于合并单元格组固定尺寸与自动换行自动调整字体大小？

Excel原生的ShrinkToFit（缩小字体填充）与WrapText（自动换行）存在互斥逻辑：开启自动换行后，缩小字体填充的效果会被覆盖，重新开启自动换行还会恢复原始字号。要解决这个问题，只能通过VBA脚本手动计算适配的字体大小，以下是具体实现方案：

实现步骤 #

1. 打开Excel，按Alt+F11打开VBA编辑器
2. 右键点击左侧工程窗口中的工作簿，选择「插入」→「模块」
3. 将以下代码粘贴到模块中：

Sub AdjustFontSizeForWrappedMergedCells()
    Dim targetRange As Range
    Dim cellWidth As Double, cellHeight As Double
    Dim tempCell As Range
    Dim currentFontSize As Double, maxFontSize As Double
    
    Set targetRange = Selection
    If targetRange.MergeCells = False Then
        MsgBox "请选中合并后的单元格！"
        Exit Sub
    End If
    
    ' 获取合并单元格的实际宽高
    cellWidth = targetRange.MergeArea.Width
    cellHeight = targetRange.MergeArea.Height
    
    ' 创建临时单元格模拟目标环境
    Set tempCell = ThisWorkbook.Sheets.Add.Range("A1")
    tempCell.Value = targetRange.Value
    tempCell.WrapText = True
    tempCell.ColumnWidth = cellWidth / tempCell.Parent.Columns("A").Width * tempCell.Parent.Columns("A").ColumnWidth
    
    maxFontSize = targetRange.Font.Size
    ' 从原字号向下遍历，找到最大适配字号
    For currentFontSize = maxFontSize To 1 Step -1
        tempCell.Font.Size = currentFontSize
        tempCell.Rows.AutoFit
        If tempCell.RowHeight <= cellHeight Then
            targetRange.Font.Size = currentFontSize
            Exit For
        End If
    Next
    
    ' 清理临时工作表
    Application.DisplayAlerts = False
    tempCell.Parent.Delete
    Application.DisplayAlerts = True
End Sub

4. 返回Excel界面，选中需要调整的合并居中且开启自动换行的单元格
5. 按Alt+F8调出宏窗口，选择AdjustFontSizeForWrappedMergedCells并执行

代码说明 #

• 先验证选中单元格是否为合并单元格，避免无效操作
• 创建临时单元格模拟目标单元格的宽度、自动换行状态，用于计算文本显示高度
• 从原字体大小开始逐步缩小，直到文本的显示高度不超过目标单元格的固定高度，将该字号应用到目标单元格
• 临时工作表会自动删除，不会残留垃圾数据

注意事项 #

• 如果文本内容过长，最终字号可能会很小，可根据需求修改循环的起始值（比如将maxFontSize改为固定数值，如12）或最小字号（将Step -1的终止值从1改为你能接受的最小字号，如6）
• 运行宏前建议保存工作簿，避免意外情况导致数据丢失

内容的提问来源于stack exchange，提问作者Cameron South