Question

我的目标是合并单元格的高度自动调整为其内容。对于这段代码，这适用于一个单元格：

 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

我不知道怎么能让它发挥作用......

Answer 1

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并告诉我它是否有效。

调整两个合并单元格的高度

1 个答案: