まえがき

Qiitaでは初投稿になります。
僕は業務上Excel方眼紙を~~使わざるを得ない~~使っているので、「横方向のセル結合が含まれる行の高さを自動調整したい」という場面によく出くわします。
ところが、シート上からの行高さ自動調整はセルの結合が含まれているセルは無視されます。
そのためVBAでこれを解決しようと試みる記事ではたまに見ますが、列幅設定の仕様をしっかり踏まえた記事は意外と少なく、何より沼が深いです。
自分の覚え書きも兼ねて、実装内容をまとめてみます。

列幅をポイント単位で設定する

列幅の単位系について

行の高さを自動調整するロジックは後述しますが、その際「列幅を指定した値に設定する」処理が必要になります。

そもそも、Excelでの列幅・行高さでは、以下の3つの単位が存在します。

単位	説明
ポイント	1ポイント = 1/72インチとのこと
ピクセル	画面の1ピクセル = Excelの1ピクセル
文字数	標準フォント・標準フォントサイズにおける`0`が何文字入るか

ちなみにExcelシート上から行高さを調整しようとした場合は以下のように表示されますが、

15.00がポイント単位、20 ピクセルが~~書いてありますが~~ピクセル単位です。
それに対し列幅を調整しようとした場合は、

13.57が文字数単位、100 ピクセルがピクセル単位です。

ポイントとピクセルに関しては同じ環境であれば同じ縮尺になりますが、
文字数に関しては標準フォントの設定に依存します。

たまに1ピクセル = 0.75 ポイントと説明しているHPを見かけますが、こちらは「ディスプレイの解像度による」や「解像度による、は誤りである」など複数の情報が混在しており明確な根拠は見当たりませんでした。今回はこの点は本題ではないので保留とします。

これを踏まえ、VBAから操作できる列幅・行高さのプロパティは以下になります。

プロパティ	説明	単位	可能な操作
RowHeights	単一行の高さ	ポイント単位	Get/Set
Heights	選択範囲の行の高さ	ポイント単位	Getのみ
ColumnWidth	単一列の幅	文字数単位	Get/Set
Width	選択範囲の列の幅	ポイント単位	Getのみ

つまり、列幅を設定したい場合は文字幅単位での設定を強制されるということです。
そのため、標準フォントによって他の単位との変換式が異なることを意識する必要があります。

先程の画像の例で、VBAからそれぞれのプロパティの値を取得してみます。

サンプルコード1

Sub Temp()
    Debug.Print "RowHeight : " & ActiveCell.RowHeight
    Debug.Print "Height : " & ActiveCell.Height
    Debug.Print "ColumnWidth : " & ActiveCell.ColumnWidth
    Debug.Print "Width : " & ActiveCell.Width
End Sub

実行結果1 (イミディエイトウィンドウ)

RowHeight : 15
Height : 15
ColumnWidth : 13.57
Width : 75

RowHeight・Heightはシート上でも確認できるポイント単位と一致しています。
ColumnWidthはシート上でも確認できる文字数単位と一致しており、Widthはシート上では確認できません。

ColumnWidthを整数倍してもWidthは整数倍にならない

さて、ColumnWidthにはもう一点厄介な仕様があります。
Microsoft公式が出しているOffice VBA リファレンスによると、列幅を2倍にする場合は以下のコードになるとのことです。

Office VBA リファレンスの例

' 次の例では、Sheet1 の列 A の幅を 2 倍にします。
With Worksheets("Sheet1").Columns("A")
    .ColumnWidth = .ColumnWidth * 2 
End With

こちらに従い、ColumnWidthとWidthの値を調べてみます。

サンプルコード2

Sub Temp()
    With ActiveCell    
        Debug.Print "Before --------"
        Debug.Print "ColumnWidth : " & .ColumnWidth
        Debug.Print "Width : " & .Width
        .ColumnWidth = .ColumnWidth * 2
        Debug.Print "After --------"
        Debug.Print "ColumnWidth : " & .ColumnWidth
        Debug.Print "Width : " & .Width    
    End With
End Sub

実行結果2 (イミディエイトウィンドウ)

Before --------
ColumnWidth : 13.57
Width : 75
After --------
ColumnWidth : 27.14
Width : 146.25

はい。見ての通り、ColumnWidthは2倍になっていますがWidthは2倍になっていません。

シート上で確認できるピクセル単位でも、100→195になっており、
結果として列幅を2倍にしたい場合ColumnWidthを単純に2倍してはいけないということになります。

ここで、今のピクセルとポイントと文字数単位での幅を地道に調べると以下の通りになります。

ピクセル	ポイント(Width)	文字数(ColumnWidth)	文字数(ColumnWidth)の差分
100	75	13.57	-
200	150	27.86	14.29
300	225	42.14	14.28
400	300	56.43	14.29
500	375	70.71	14.28

突然文字数(ColumnWidth)の差分という列が登場しましたが、つまりこの表からは

ポイント(Width)とピクセルは比例する
ポイント(Width)と文字数(ColumnWidth)は比例しないが、1次関数の形式で表せる

という推測が立ちます。
ここでは省略しますが、標準フォント・標準フォントサイズを変更しても上記は成り立ちそうでした。
おそらくどこかの資料にはこの旨が明記されているのでしょうが、この点の証明が記事の主題ではないため明確な裏取りは省略します。

参考にさせて頂いたHPを記事の末尾に記載していますが、どうやら
「ColumnWidthは文字の余白を考慮しているのではないか」ということらしいです。

列幅をポイント単位で設定する

今まで記載した仕様より、WidthとColumnWidthの変換式は

Width = ColumnWidth * WidthRatio(倍率) + MarginWidth(余白のポイント数)

となることがわかります。
ColumnWidthに適当な値を2つ代入してWidthを求めれば、
後はWidthRatio(倍率)とMarginWidth(余白のポイント数)の1次方程式となり、めでたく変換式が完成するわけですね。

以上を踏まえ、列幅をポイント単位で設定するプロシージャは以下になります。

列幅をポイント単位で設定する

' 倍率・余白のポイント数算出用の定数
Private Const TEMP_NARROW_COLUMN_WIDTH = 50
Private Const TEMP_WIDE_COLUMN_WIDTH = 100

'/**
' * 選択セルの列幅をポイント単位で設定する
' * @params TargetColumns : 変更対象の列(複数列許容・セル選択も許容)
' * @params Width : 設定したい列幅(ポイント単位)
' */
Sub SetWidthByPoint(ByVal TargetColumns As Range, Width As Double)

    ' 列幅計算用として作業列を1列確保する(列幅変更対象列の1列目を使用)
    Dim ColumnForCalc As Range
    Set ColumnForCalc = TargetColumns.Columns.Item(1)

    ' ColumnWidth = TEMP_NARROW_COLUMN_WIDTH の時のWidthを取得する
    Dim TempNarrowWidth As Double
    ColumnForCalc.ColumnWidth = TEMP_NARROW_COLUMN_WIDTH
    TempNarrowWidth = ColumnForCalc.Width

    ' ColumnWidth = TEMP_WIDE_COLUMN_WIDTH の時のWidthを取得する
    Dim TempWideWidth As Double
    ColumnForCalc.ColumnWidth = TEMP_WIDE_COLUMN_WIDTH
    TempWideWidth = ColumnForCalc.Width
    
    ' 上記値から、ColumnWidth / Width の倍率・余白のポイント数を求める
    Dim WidthRatio As Double
    WidthRatio = (TempWideWidth - TempNarrowWidth) / (TEMP_WIDE_COLUMN_WIDTH - TEMP_NARROW_COLUMN_WIDTH)

    Dim MarginWidth As Double
    MarginWidth = TempWideWidth - WidthRatio * TEMP_WIDE_COLUMN_WIDTH
    
    ' 列幅設定
    TargetColumns.ColumnWidth = (Width - MarginWidth) / WidthRatio

End Sub

列幅を変更したい列に対し一旦ColumnWidth = 定数の列幅にして変換式を求めた後、本来の設定したい列幅に設定し直すロジックです。
定数はここでは50と100を使っていますが、多分なんでも良いです。
注意点として、引数のTargetColumnsが複数列選択されているとWidthの取得結果が変わるので、
変換式を計算する段階では1列だけ抜き出して使用しています。

上記のプロシージャの最後にデバッグ用関数を仕込んだ上で試してみます。

標準フォントがメイリオ・標準フォントサイズが9の時、このプロシージャを呼び出すと

サンプルコード3

Call SetWidthByPoint(ActiveCell, 150)

実行結果3 (イミディエイトウィンドウ)

WidthRatio : 5.25
MarginWidth : 3.75
ColumnWidth : 27.86
Width : 150

サンプルコード4

Call SetWidthByPoint(ActiveCell, 777)

実行結果4 (イミディエイトウィンドウ)

WidthRatio : 5.25
MarginWidth : 3.75
ColumnWidth : 147.29
Width : 777

良い感じですね。

標準フォント・標準フォントサイズを変えてみます。

けいふぉんとの24にしました。
これで先ほどのプロシージャを実行してみます。

サンプルコード5

Call SetWidthByPoint(ActiveCell, 555)

実行結果5 (イミディエイトウィンドウ)

WidthRatio : 14.25
MarginWidth : 8.25
ColumnWidth : 38.37
Width : 555

WidthRatioとMarginWidthの値が変化していることがわかると思います。
フォントのせいでシートの見た目が愉快ですが、列幅はきちんと設定されていますね。

あまり細い列幅にしようとすると、誤差が出ます。

サンプルコード6

Call SetWidthByPoint(ActiveCell, 20)

実行結果6 (イミディエイトウィンドウ)

WidthRatio : 5.25
MarginWidth : 3.75
ColumnWidth : 3.14
Width : 20.25

いわゆる丸め誤差だとは思うのですが、この点は制約として仕方が無いのかなと思っています。
良い改善策あれば教えてください。

行の高さを自動調整する

ようやくやりたかったことがやれます。
行高さ自動調整のロジックとしては、

結合セルがあった場合、「結合範囲を記憶する」「1列目の列幅を結合範囲まで広げる」「結合解除する」の順に行う
上記が1行分完了したら、行の高さを自動調整する
1.の操作を元に戻す
上記を1行ずつ繰り返す

となります。
この「1列目の列幅を結合範囲まで広げる」およびそれを元に戻す操作において、正しく列幅を取得・設定する必要があったわけですね。
こちらを踏まえ、行高さ自動調整プロシージャは以下になります。

選択セル基準で行高さ自動調整(横方向セル結合にも対応)

' 行高さ自動調整時の選択セル数上限
Private Const LIMIT_CELL_COUNT = 300

'/**
' * 選択セル基準で行高さ自動調整(横方向セル結合にも対応)
' */
Sub AlignRowHeights()
    
    ' 実行前チェック
    If Selection.Cells.Count > LIMIT_CELL_COUNT Then
        If MsgBox("選択中のセルが" & LIMIT_CELL_COUNT & "個を超えています。" & vbCrLf & "本当に実行しますか？", vbOKCancel) <> vbOK Then
            Exit Sub
        End If
    End If
    
    ' 確認ダイアログ非表示
    Application.DisplayAlerts = False

    ' 1行ずつ処理
    Dim TargetRow As Range
    For Each TargetRow In Selection.Rows
    
        ' 結合セルを格納しておくコレクションを用意
        Dim MergedAreas As Collection: Set MergedAreas = New Collection
        
        ' 結合セルがあった場合解除し、1列目を結合範囲の列幅に広げる
        Dim TargetCell As Range
        For Each TargetCell In TargetRow.Cells
        
            ' セルが結合されている場合
            If TargetCell.MergeCells = True Then
            
                ' 結合セルの範囲を記憶
                Call MergedAreas.Add(TargetCell.MergeArea)
                
                ' 結合セルの範囲の列幅を取得
                Dim CurrentWidth As Double
                CurrentWidth = TargetCell.MergeArea.Width
                
                ' 1列目の列幅を結合範囲の列幅に広げる
                Call SetWidthByPoint(TargetCell, CurrentWidth)
                
                ' セル結合を解除
                TargetCell.MergeArea.UnMerge            
            End If
        Next TargetCell
        
        ' 行の高さ調整
        Call TargetRow.AutoFit
        
        ' 結合セルを元に戻す
        Dim EachMergedArea As Range
        For Each EachMergedArea In MergedAreas
        
            ' 結合セル範囲の現在の列幅を取得
            Dim ModifiedWidth As Double
            ModifiedWidth = EachMergedArea.Width
            
            ' 元の列幅を算出
            ' 元の列幅が1列目:x、結合範囲全体:yだった場合
            ' 今の列幅は1列目:x+y、結合範囲全体:(x+y)+y=x+2y となっている
            ' → x = 2 * (x + y) - (x + 2y) で算出可能
            Dim OriginalWidth As Double
            OriginalWidth = 2 * EachMergedArea.Cells.Item(1).Width - ModifiedWidth
            
            ' 列幅とセル結合を元に戻す
            Call SetWidthByPoint(EachMergedArea.Cells.Item(1), OriginalWidth)
            Call EachMergedArea.Merge            
        Next EachMergedArea        
    Next TargetRow
    
    ' 確認ダイアログ再表示
    Application.DisplayAlerts = True
        
End Sub

結合セルを解除する度にダイアログが出るのを防ぐため、Application.DisplayAlerts = Falseを入れています。
また環境によりますがこの処理は結構重いので、選択セルが一定以上な場合は本当に実行するか確認するようにしています。

(そんな使い方をすることがあるのかは不明ですが)「特定のセルの折り返し改行は考慮したくない」といった場合も踏まえ
.WrapText = Trueは敢えて入れていませんが、当然「折り返して全体を表示する」を設定していないと改行されません。

今回縦方向のセル結合は考慮していません。
これを考慮する場合、「行の高さ拡大分を1行目に持たせるのか・均等に配分するのか」といった要件面の問題や、
そもそもコードがより複雑になることから今回は考慮しませんでした。

おわりに

簡潔にやるのであればWidthに適当に定数を足すなどすれば似たようなことは出来ると思うのですが、
きちんと余分な空行分が出ないように組んでみたかったので試行錯誤してみました。
参考になれば幸いです。

Widthが設定可能プロパティだったらこんなに苦労せずに済んだんですけどね。

参考にさせて頂いたHP