Question

我使用VBA生成一个巨大的Excel模板。有一个标准的合并单元格列包含不同长度的各种描述。单独这个标准描述列很好，因为所有行当前都设置了正确的长度。

第二列由用于评论的单个单元格组成，这些单元格将始终具有不同的文本长度。当然，当用户输入被设置为预定单元格的值时：很可能会切断文本行。这是一个常见问题，显而易见的解决方案是设置宏来运行行高自动调整。

这是问题的开始。

当第二列上运行行高自动调整以进行用户注释时，第一列描述中的许多合并单元格将设置为行高太小而无法显示其所有文本。

有关如何在不降低第一列行高的情况下运行行高自动调整第二列用户注释的任何想法？

有没有办法设置最小行高并仍然运行自动调整？

Answer 1

这对我有用。如果文本将被截断，它会通过调整最后一个单元格的行高来调整第一列合并单元格的大小。

稍微复杂的版本可能会划分合并区域中所有行之间的高度差，而不是将其添加到单个行中。我可以把它留作练习......

Sub FixHeights()

Dim rng As Range, col As Range, m As Range, c As Range
Dim i As Long, n As Long, fh
Dim fHeights()

    Set rng = Range("B4:C11") 'for example...

    'to store merged areas and their fitted heights
    ReDim fHeights(1 To rng.Rows.Count, 1 To 2)

    'run though the first column and find merged
    '  areas and "fitted heights"
    Set col = rng.Columns(1)
    n = 0
    For Each c In col.Cells
        Set m = c.MergeArea
        If m.Cells.Count > 1 And c.Row = m.Cells(1).Row Then
            n = n + 1
            Set fHeights(n, 1) = m
            fHeights(n, 2) = GetFittedHeight(m)
        End If
    Next c

    'autofit the second column row heights
    rng.Columns(2).Rows.AutoFit

    'recheck the first column: if any merged area is
    '  too short, then increase the last row's height
    For i = 1 To n
        Set m = fHeights(i, 1)
        fh = fHeights(i, 2)
        Debug.Print m.Height, fh
        If m.Height < fh Then
            With m.Cells(m.Cells.Count)
                .RowHeight = .RowHeight + (fh - m.Height)
            End With
        End If
    Next i

End Sub

'get the "fitted height" of a merged area
Function GetFittedHeight(ma As Range)
Dim ht
    With ma
        .UnMerge
        .Cells(1).EntireRow.AutoFit
        ht = .Cells(1).RowHeight
        .Merge
        .EntireRow.AutoFit
    End With
    GetFittedHeight = ht
End Function

在两者上自动调整行高：具有合并单元格的列和具有单个单元格的列

1 个答案: