VBA 狙った範囲だけをAutoFitするマクロ

以下のような表を作ったとき、普通にオートフィットをかけるとA1セルに入力されたタイトルの幅もカウントされてしまい、幅がおかしくなる。

↓AutoFit後

今回はこれを何とかするマクロ。

元ネタはこちら。

こういった表、よく作るんですが、列幅のオートフィットをさせたい時、タイトル部分が邪魔をしてA列だけびよ～～～～ん！ってなります。

・対策はセルの結合
・使わない（ページ設定のヘッダを使う）
くらいしか思いつかないんですが、他に良いアイディアありますか？ pic.twitter.com/xpatLj7Szi

— ことりちゅん@えくせるしゅきしゅきVBAしゅみぐらま (@KotorinChunChun) 2019年3月1日

では、早速コードを紹介しよう。

ただし、注意点として、このマクロはシート上のデータをすべて変数に退避させて一旦消す処理を含むので、マクロがコケた場合は対象データ全消失もありえる。試す場合はくれぐれもファイルを保存してからどうぞ。
念のため言ってるだけなので、実際そんなことにはならないと思うけど。

Sub SmartFit()
    Const MAX_COLUMN_WIDTH = 80
    If TypeName(ActiveSheet) <> "Worksheet" Then
        MsgBox "このマクロはワークシート上で実行してください。", vbExclamation
        Exit Sub
    End If
    
    Dim sh As Worksheet: Set sh = ActiveSheet
    
    Dim targetArea As Range: Set targetArea = Selection.CurrentRegion
    targetArea.Select
    If vbYes <> MsgBox("選択エリアに対してSmartFitを適用しますか？", vbQuestion + vbYesNo, "確認") Then
        MsgBox "キャンセルしました。", vbInformation
        Exit Sub
    End If
    
    
    With sh
        Dim wholeArea As Range: Set wholeArea = .Range(.Cells(1, 1), .Cells.SpecialCells(xlCellTypeLastCell))
        Dim wholeBackup: wholeBackup = wholeArea.Formula
        Dim targetBackup: targetBackup = targetArea.Formula
        
        wholeArea.ClearContents
        targetArea.Formula = targetBackup
        
        Dim zoomLevel As Long
        zoomLevel = ActiveWindow.Zoom
        ActiveWindow.Zoom = 100
        With targetArea
            .EntireColumn.ColumnWidth = MAX_COLUMN_WIDTH
            .EntireRow.AutoFit
            .EntireColumn.AutoFit
        End With
        ActiveWindow.Zoom = zoomLevel
        
        wholeArea.Formula = wholeBackup
    End With
    
    MsgBox "実行しました。", vbInformation
End Sub

使い方

対象の表内の特定セルを選択した状態で実行する。

※シート内ならどこでも良いわけではなく、実際にオートフィットさせたい表内の任意セルを選ぶこと。例えばタイトルを書いたA1セルを選んで実行すると上手く行かない。CurrentRegionで範囲を決定しているため、表とそれ以外の要素は空行・空列で区切られていなければならない。

実行すると表全体が選択され、この範囲で実行して良いかの確認メッセージが表示される。

「はい」を選ぶと対象範囲のみを基準にAutoFitされる。

解説

※画像のサイズが不ぞろいなのはご愛敬。。
以下の画像を見ていただけると、大体何をやってるか分かると思う。

以上