Question

我有一个AutoFitMergedCellRowHeight子例程，它将合并的单元格作为参数，然后修复其高度，以便所有文本都可见。按下按钮时会激活FixAll子。

问题是它的行为是不稳定的。当选择与合并单元格在同一列中的单元格（第4列）时，高度为一个大小（较小，但文本100％可见）;当在该列之外选择一个单元格但在表格内部没有任何反应时;当在桌子外面选择一个单元格时，高度是固定的但是太大了。

为什么会这样？我无法看到与子网中所选单元格相关的任何内容。

Sub FitAll()
   AutoFitMergedCellRowHeight (Cells(3, 4))
End Sub

Sub AutoFitMergedCellRowHeight(cell As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    If cell.MergeCells Then
        With cell.MergeArea
            .WrapText = True
            If .Rows.Count = 1 Then
                cell = cell.MergeArea.Cells(1, 1)
                MsgBox (cell.Row & "and" & cell.Column)

                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = cell.ColumnWidth
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + 
                        MergedCellRgWidth

                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = ActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                CurrentRowHeight, PossNewRowHeight)

            End If
        End With
    End If
End Sub

编辑：我也将我的结果与不使用参数但是使用选定单元格的同一个子进行比较。即使应用了CLR建议的更改后，结果也会有所不同。

Sub AutoFitMergedActiveCellRowHeight()
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    If ActiveCell.MergeCells Then
        With ActiveCell.MergeArea
            .WrapText = True
            If .Rows.Count = 1 Then
                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = ActiveCell.ColumnWidth
                For Each CurrCell In Selection
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth

                Next
                .MergeCells = False
                .Cells(1).ColumnWidth = MergedCellRgWidth
                .EntireRow.AutoFit
                PossNewRowHeight = .RowHeight
                .Cells(1).ColumnWidth = ActiveCellWidth
                .MergeCells = True
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
                CurrentRowHeight, PossNewRowHeight)
            End If
        End With
    End If
    'MsgBox ("DONE")
    MsgBox (ActiveCell.Row & "and" & ActiveCell.Column)
End Sub

Answer 1

For Each CurrCell In Selection正在查看选定的单元格，而不是参数传递的单元格。

我想你要替换：

For Each CurrCell In Selection
    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next

有类似的东西：

For Each CurrCell In cell.MergeArea
    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next

VBA宏的行为取决于所选单元格

1 个答案: