このサイトはCocoonを使っています。現在「ミックスブルー [作者: y.hiroaki氏]」スキンを適用中です(^^)/

Excel VBA セルの書式を他のセル範囲に適用する汎用ツール

スポンサーリンク

セルの書式設定をする場合、設定する範囲を選択し「セルの書式設定」から各種設定を行います。いつもの決まった設定なのに結構面倒な作業です。既存セルの書式設定をコピーしてくる方法もありますが手動ではやはり手間が発生します。そこで、あらかじめ書式設定しておいたセルからVBAで目的のセル範囲にその書式を設定してしまえばこの問題は解決できます
効率化が図れる簡単なツールを設定してみましたので、是非一度使ってみてください。この記事では、その簡易ツールについて詳しく解説していきます

くるみこ
くるみこ

というわけで、前回同様に今回もApplication.InputBox使います。セルの書式設定を読み込んで使う方法は前なきと変わりませんが、面倒な罫線の設定などについて詳しく解説したいと思います!

書式設定を効率化できるなんて、すごく助かります。

是非よろしくお願いしますm(_ _)m

前回のおさらいはこちらの記事です(^^)/ 下のカードをクリックすれば開きます

くるみこ
くるみこ

前回記事でわかったことは

・シートのセル範囲データを配列を使って比較する方法
・Application.InputBoxを利用した場合と設定セルを利用する方法
・Functionステートメントでセル書式を調べる関数について解説
・関数の戻り値に区切り文字をセットして、Sprit関数で一次元配列にする方法

【この記事でわかること
・セルの書式設定を取得して配列に組み込む方法
・Application.InputBoxを利用して設定セルの指定と目的範囲を設定する方法

・セルに罫線の書式を取得・設定する方法

スポンサーリンク

設定したいセル書式をセル範囲に反映させる方法

設定したい書式を「見本セル」に設定しておきます。VBAでその書式設定を取得して、選択セル範囲にその書式を設定する方法を紹介していきます

処理のロジックをフロー図で検討

前回記事で紹介したロジックを流用して処理フローを確認します

・このようなフローになるように考えて書いたコードが次のサンプルです
設定に利用するセル書式をあらかじめ「見本セル」に作っておく必要があります

セル範囲の書式設定をVBAで設定する

指定セル範囲に「見本セル」の書式を設定するコード

'「見本セル」の書式設定を指定セル範囲に設定する
Sub FormattingCells()
    Dim rn As Range
    Dim sh As Worksheet
    Dim oldList As Variant
    Dim chk(27) As Variant
    Dim i As Long, j As Long
    Dim sr As Long, sc As Long, er As Long, ec As Long
 
    For i = 1 To 27
        chk(i) = Cells(i + 1, 2).Value
    Next

    On Error Resume Next
    Set rn = Application.InputBox( _
                Prompt:="設定対象範囲(表)の先頭セルを選択してください!" _
                & vbCrLf & "または、対象セル範囲を選択指定してください!" _
                , Title:="書式設定セル範囲選択", Type:=8)
    On Error GoTo 0
    If rn Is Nothing Then Exit Sub
    Set sh = rn.Worksheet
    
    sh.Activate    '元シートの設定を調べる
    sr = rn.Row       '開始行取得
    sc = rn.Column    '開始列取得
    '取得セル範囲を2次元配列に一括代入する
    If rn.Count = 1 Then
        'セル選択が1個の場合
        '元シートの最終行列取得
        er = sr + sh.Cells(sr, sc).CurrentRegion.Rows.Count - 1
        ec = sc + sh.Cells(sr, sc).CurrentRegion.Columns.Count - 1
        'セル範囲データを配列に入れる
        oldList = sh.Range(Cells(sr, sc), Cells(er, ec)).Value
    Else
        'セルを複数(範囲で)選択している場合
        oldList = rn.Value
    End If
    Set rn = Nothing
    
    '差分があった場合のセル配色などを設定
    Dim a As Variant
    a = Split(GetCellsFormat, ",")
    If IsArray(a) = False Then GoTo Ex
    
    Application.ScreenUpdating = False              '画面描画を停止
    Application.Calculation = xlCalculationManual   '計算を手動に
    '対象シートを基準でループ
    On Error Resume Next    'エラー発生時(データが無い)止めない
    For i = 1 To UBound(oldList, 1)
        For j = 1 To UBound(oldList, 2)
            With sh.Cells(i + sr - 1, j + sc - 1)
                If chk(24) = 1 Then .Borders.LineStyle = False    '線の種類
                If chk(1) = 1 Then .NumberFormatLocal = a(1) '書式
                If chk(2) = 1 Then .HorizontalAlignment = Val(a(2)) '横位置
                If chk(3) = 1 Then .VerticalAlignment = Val(a(3))  '縦位置
                If chk(4) = 1 Then .AddIndent = CBool(a(4))    '前後にスペースを入れる
                If chk(5) = 1 Then .IndentLevel = Val(a(5))    'インデント
                If chk(6) = 1 Then .WrapText = CBool(a(6))       '折り返して全体を表示する
                If chk(7) = 1 Then .ShrinkToFit = CBool(a(7))    '縮小して全体を表示する
                If chk(8) = 1 Then .MergeCells = CBool(a(8))     'セルを結合する
                If chk(9) = 1 Then .ReadingOrder = Val(a(9))   '文字の方向
                If chk(10) = 1 Then .Orientation = Val(a(10))    '方向の角度
                If chk(11) = 1 Then .Font.Color = Val(a(11))     '文字色
                If chk(12) = 1 Then .Font.Name = a(12)      'フォント名前
                If chk(13) = 1 Then .Font.Size = Val(a(13))      'サイズ
                If chk(14) = 1 Then .Font.Bold = CBool(a(14))      '太字
                If chk(15) = 1 Then .Font.Italic = CBool(a(15))        '斜体イタリック
                If chk(16) = 1 Then .Font.Underline = Val(a(16))     '下線
                If chk(17) = 1 Then .Font.Strikethrough = CBool(a(17)) '取り消し線
                If chk(18) = 1 Then .Font.Superscript = CBool(a(18))   '上付き文字
                If chk(19) = 1 Then .Font.Subscript = Val(a(19))     '下付き文字
                If chk(20) = 1 Then .Borders.Color = Val(a(20))      '罫線の色
                If chk(21) = 1 Then
                    .Borders.Weight = Val(a(21))                '線の太さ全般
                    .Borders(xlEdgeTop).Weight = Val(a(21))     '上側罫線の太さ
                    .Borders(xlEdgeLeft).Weight = Val(a(21))    '左側罫線の太さ
                End If
                If chk(22) = 1 Then .Borders(xlDiagonalDown).LineStyle = Val(a(22))  '左上隅から右下への罫線
                If chk(23) = 1 Then .Borders(xlDiagonalUp).LineStyle = Val(a(23)) '左下隅から右上への罫線
                If chk(24) = 1 Then .Borders.LineStyle = Val(a(24))  '線の種類
                If chk(25) = 1 Then .Interior.Color = Val(a(25))     '背景色
                If chk(26) = 1 Then .Interior.Pattern = Val(a(26))   'パターン
                If chk(27) = 1 Then .Locked = CBool(a(27))         '保護設定
            End With
        Next j
    Next i
    On Error GoTo 0
    Application.Calculation = xlCalculationAutomatic '計算を自動に
    Application.ScreenUpdating = True               '画面描画を開始
Ex:
    Set sh = Nothing

End Sub

以下、コード内にコメントを入れていない部分を解説します

10~12行目で、取得設定するセルの書式項目をB列のセルから設定フラグ(1で設定する)を読み込んでいます(項目種別はC列に記載)。不必要な項目はセットしない方が動作は早くなります
・15行目、書式を設定するセル範囲をApplication.InputBoxで選択します。選択された範囲は配列に設定します
・42行目で、セル書式設定を取得する関数を呼び出しています(関数の動作は後で解説します)。戻り値は、Split関数でカンマ区切りで分割して配列に代入しています
・49~86行目は、取得した書式をセル範囲に適用する処理です
73~77行目で、罫線の太さを設定しています。線種によってはうまく反映しないので、上側と左側を個別に設定して反映させるようにしています
78~79行目は、斜め罫線の設定です。これも個別設定しまいと反映しない項目でした
設定を代入する場合、数値はVal関数、”True””False”はCBool関数で文字列を変換しています

・罫線を設定する場合は、罫線関連の設定項目はすべて選択するようにしてください!

指定セルの書式を取得する関数(Functionステートメント)

・上のコードから呼び出される関数のコードです

'指定セルの書式取得用関数
Function GetCellsFormat() As Variant
    Dim rn As Range
    Dim a As Variant
 
    On Error Resume Next
    Set rn = Application.InputBox( _
                Prompt:="「見本となる」セルを選択してください!" _
                , Title:="見本セル選択", Type:=8)
    On Error GoTo 0
    If rn Is Nothing Then Exit Function

    a = "0"     '配列0用データをセット
    '【セルの書式設定を取得】
    With rn '.Cells(1, 1)
        a = a & "," & .NumberFormatLocal    '表示形式
        a = a & "," & .HorizontalAlignment  '文字横位置
        a = a & "," & .VerticalAlignment    '文字縦位置
        a = a & "," & .AddIndent    '前後にスペースを入れる
        a = a & "," & .IndentLevel  'インデント
        a = a & "," & .WrapText     '折り返して全体を表示する
        a = a & "," & .ShrinkToFit  '縮小して全体を表示する
        a = a & "," & .MergeCells   'セルを結合する
        a = a & "," & .ReadingOrder '文字の方向
        a = a & "," & .Orientation  '方向の角度
        a = a & "," & .Font.Color   '文字色
        a = a & "," & .Font.Name    'フォント名
        a = a & "," & .Font.Size    'サイズ
        a = a & "," & .Font.Bold    '太字
        a = a & "," & .Font.Italic       '斜体
        a = a & "," & .Font.Underline    '下線
        a = a & "," & .Font.Strikethrough   '取り消し線
        a = a & "," & .Font.Superscript     '上付き文字
        a = a & "," & .Font.Subscript       '下付き文字
        a = a & "," & .Borders.Color    '罫線色
        a = a & "," & .Borders.Weight   '罫線太さ
        a = a & "," & .Borders(xlDiagonalDown).LineStyle '左上隅から右下への罫線
        a = a & "," & .Borders(xlDiagonalUp).LineStyle '左下隅から右上への罫線
        a = a & "," & .Borders.LineStyle '罫線種類(これは一番最後にすること)
        a = a & "," & .Interior.Color   '背景色
        a = a & "," & .Interior.Pattern 'パターン
        a = a & "," & .Locked           '保護設定
    End With

    GetCellsFormat = a

End Function

使いたい設定をあらかじめどこかのセルを使って「見本セル」を設定しておきます
・7行目、Applocation.InputBox で「見本セル」を選択させます
・13行目は、配列にした場合の要素0に捨てデータを設定しています
・15~43行で、セルの書式項目を取得して変数「a」に「,」区切りで代入していきます
・22行目で、関数GetCellsFormatに変数「a」の値を代入しています

スポンサーリンク

まとめ(おわりに)

・いかがでしたでしょうか?
「いつも汎用でだれでも使えて活用できるように考えてvbaを使う」というポリシーを念頭に今回の記事も書いたつもりです
実行例のイメージが掴みづらいので「GIF画像」を配置しています
・別ブックが対象でも問題なく動作すると思います
実際にはいろいろな動作が考えられます。是非、実際に動かしてみてください!
サンプルファイルを用意していますのでよろしければお使いください(^^)

まとめと感想など

くるみこ
くるみこ

今回は、前回設定しなかった罫線などの難しい書式設定を扱いました。少し苦労しましたが、何とかまともに設定できるようになったと思います(^^)
今回の解説はいかがでしたか?

はい! 罫線の設定は順番が違うと設定できなかったりしてすごく難しかったです!

でもすごく勉強になりました(^^)活用できるように頑張ります!

くるみこ
くるみこ

今回紹介したコードは、別ブックのセル範囲も設定でるので単独のツールとしても汎用的に活用できます。これもApplication.InputBoxを使ったので簡単に実現できている部分ですね(^^) 次回解説までまた少し待っていてね!

【今回分かったことは】
セル範囲に書式設定を代入する場合、型変換を行う必要がありました
 (数値はVal関数で変換、Bool型はCBool関数で文字列から変換しています
・罫線の設定はBorders.LineStyleを一番最後に設定する必要がありました
Borders.Weightの設定も線類によっては上側(xlEdgeTop)と左側(xlEdgeLeft)を個別に設定しないと動作が不安定でした
・斜め罫線の設定も個別に設定しないと反映しませんでした

マクロ(VBA)を実行する際は必ずバックアップを取ってから行ってください!
・マクロ(VBA)は実行後にファイルを保存すると元に戻すことはできません!
・実行後にファイルを保存せず終了すれば、実行前に戻すことができます!


ブログランキングに参加しています(^^) 応援よろしくお願いしますm(_ _)m

今後の記事について

今回の記事はいかがだったでしょうか。皆さまのお役に立てたなら幸いです(^^;
「汎用でだれでも使えて活用できるように考えてvbaを使う」というポリシーで
当面は「中級者?向けマクロVBA」の記事を継続して書いていきたいと思っています

【検討中の今後の記事内容は・・・・・】
・実務に役立つものを提供できるよう現在検討中です
・その他雑記的に「小ネタなどいろいろ」・・・・・
・今後の記事にもご期待ください(^^)/

記事のサンプルファイルをダウンロードできます

今回の記事のサンプルをダウンロードできるようにしています
過去の記事で使用したサンプルファイルがダウンロードできるページを設置しています
こちら(このリンク先)からご利用ください

スポンサーリンク

スポンサーリンク