調整兩個合並單元格的高度

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並告訴我是否可行。