0

我的目标是合并单元格的高度自动调整到其内容。这适用于具有这段代码的一个单元格:

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim h, rng As Range

    Set rng = Selection

    If ActiveCell.MergeCells Then
        With ActiveCell.MergeArea
            If .WrapText = True Then
                With rng
                    .UnMerge
                    .Cells(1).EntireRow.AutoFit
                    h = .Cells(1).RowHeight
                    .Merge
                    .EntireRow.AutoFit

                    With .Cells(1).MergeArea
                        .Cells(.Cells.Count).RowHeight = (h - .Height + 14.25)
                    End With
                End With
            End If
        End With
    End If
End Sub

但是,如果我在同一行中有两个单元格并且第二个单元格较短,则它会调整为第二个单元格。(请参见下面的示例)

图片

关于如何解决这个问题的任何想法,以便它只在同一行中没有更高高度的单元格时进行调整?

这是一个更新的版本。顺便提一句。单元格都在同一列(AS 和 AU)

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)


 Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
 If ActiveCell.MergeCells Then


 Dim heigtAS, heightAU As Integer

  'AS-Block
 Dim hAS, rngAS As Range
    Set rngAS = Range("AS10:AS18")

    With rngAS.MergeArea
         If .WrapText = True Then
             With rngAS
            .UnMerge
            .Cells(1).EntireRow.AutoFit
             hAS = .Cells(1).RowHeight
            .Merge
            .EntireRow.AutoFit
            With .Cells(1).MergeArea
            heightAS = (hAS - .Height + 14.25)
            'save height of cell

            End With
            End With

         End If
     End With

 'AU-Block
 Dim hAU, rngAU As Range
 Set rngAU = Range("AU10:AU18")

    With rngAU.MergeArea
         If .WrapText = True Then
             With rngAU
            .UnMerge
            .Cells(1).EntireRow.AutoFit
             hAU = .Cells(1).RowHeight
            .Merge
            .EntireRow.AutoFit
            With .Cells(1).MergeArea
            heightAU = (hAU - .Height + 14.25)
            'save height of cell



            End With
            End With

         End If
     End With


 'Compare height and fit cell height
If heightAS > heightAU Then
    .Cells(.Cells.Count).RowHeight = heightAS
Else
    .Cells(.Cells.Count).RowHeight = heightAU
End If
End If


End Sub

我莫名其妙无法让它工作......

4

1 回答 1

0
private void MergeAndFit(Range range)
    {
        range.MergeCells = false;
        double cellWidth = range.Columns[1].ColumnWidth;
        double mergeWidth = 0;
        foreach (Range cm in range)
        {
            cm.WrapText = true;
            mergeWidth += cm.ColumnWidth;
        }

        mergeWidth = mergeWidth + range.Cells.Count * 0.66;
        range.Columns[1].ColumnWidth = mergeWidth;
        range.EntireRow.AutoFit();
        double newRowHeight = range.RowHeight;
        range.Columns[1].ColumnWidth = cellWidth;
        range.MergeCells = true;
        range.RowHeight = newRowHeight;
    }

上面的函数需要一个 excel 范围对象并合并单元格。将行高设置为最大值以显示所有内容。我不确定这是否适合您,但您可以将其转换为 vb.net 并告诉我它是否有效。

于 2014-10-15T23:50:24.370 回答