t-hom’s diary

主にVBAネタを扱っているブログです。

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

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

↓AutoFit後
f:id:t-hom:20190306001709p:plain

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

元ネタはこちら。


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

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

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

使い方

対象の表内の特定セルを選択した状態で実行する。
f:id:t-hom:20190306002236p:plain

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

実行すると表全体が選択され、この範囲で実行して良いかの確認メッセージが表示される。
f:id:t-hom:20190306002414p:plain

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

解説

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

f:id:t-hom:20190306003344p:plain

f:id:t-hom:20190306003454p:plain

f:id:t-hom:20190306003802p:plain

f:id:t-hom:20190306003917p:plain

以上

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。