0

私の目標は、結合されたセルの高さがその内容に合わせて自動的に調整されることです。これは、次のコードで 1 つのセルに対して正常に機能します。

 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

ただし、同じ行に2つのセルがあり、2番目のセルが短い場合、2番目のセルに合わせて調整されます..(下の例を参照)

写真

同じ行に高さの高いセルがない場合にのみ調整されるように、これを修正する方法についてのアイデアはありますか?

これが更新されたバージョンです。ところで。セルはすべて同じ列にあります (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 に答える