本ページには広告が含まれています。

Excel条件付き書式をVBAで保存設定する【実務で活用できる】

Excel 条件付き書式設定をVBAで保存設定

増殖してしまったExcelの条件付き書式を整理するために
前回記事で、Excelの「条件付き書式」を一括で削除する処理を紹介しました

この記事で、増殖してしまった「条件付き書式」を整理する解決方法は「条件付き書式のルールをクリアして再設定」するということで、次のように整理しました

【VBAを使って整理する手順】
① 設定されている「条件付き書式」を書き出す(設定を保存しておく)
② 「条件付き書式」を全て削除する
③ 書き出した「条件付き書式」設定を整理・調整(範囲設定など)する(ここは手動で)
④ 調整済みの「条件付き書式」設定をVBAでブックに反映させる

前回記事では、この②の削除部分を紹介しました。この記事では①③④について解説します

条件付き書式」を整理・再設定する方法について検討していきます。是非ご覧ください!

スポンサーリンク

Excelの「条件付き書式」設定について前回記事のおさらい

【Excelの「条件付き書式」設定の問題点】
・大量の「条件付き書式」でExcelの処理が重くなる
・コピぺで「条件付き書式」設定もコピーされて増殖する
・削除で「条件付き書式」の設定が分断されその結果増殖する

【条件付き書式が遅くならないようにするには】
・範囲を決めて設定する(行や列全体で設定しない)
・コピペはせずに値で貼り付ける
・条件は一つの数式にまとめる
【増殖を防ぐ方法】のひとつは
「ファイル」「オプション」「詳細設定」の編集設定の中の「データ範囲の形式および数式を拡張する」のチェックを外しておけば増殖しないけど
「条件付き書式」を設定していない部分も拡張しなくなってしまいます

Excelの「条件付き書式」の設定をVBAで整理しよう

VBAで現在設定中の「条件付き書式」を取得してセルに書き出す

・このVBAで現在設定中の「条件付き書式」設定をセル書き出します(設定を保存します)(^^;

Option Explicit
'条件付き書式設定取得
Sub GetFormatConditions()
    Dim i As Long
    Dim j As Long
    Dim tr As Long
    Dim re As Long
    Dim vFileName As Variant
    Dim sh As Worksheet
    Set sh = ThisWorkbook.ActiveSheet
    Dim wb As Workbook
    If sh.Range("A7").Value <> "" Then
        vFileName = sh.Range("A7").Value
    Else: vFileName = ""
    End If
    Application.ScreenUpdating = False      '画面表示抑制
    If chkWbOpened(vFileName) = False Then  '設定のファイルが開いているか調べる
        vFileName = Application.GetOpenFilename( _
                FileFilter:="Excelワークブック,*.xls?", _
                Title:="ファイルを指定して下さい", _
                MultiSelect:=False) '単一ファイルにする
        If vFileName = "" Then _
                MsgBox ("未選択のため処理を中止します!"): Exit Sub
        Set wb = Workbooks.Open(vFileName)      '選択ブックを開いてセット
    Else: Set wb = Workbooks(Dir(vFileName))    '開いているブックをセット
    End If
    sh.Activate
    If sh.Range("A9") <> "" Then
        re = MsgBox("シートに保存している設定を消去してよろしいですか?", _
                    vbExclamation + vbYesNo, "動作選択")
        If re = vbNo Then MsgBox "処理を中止します!": Exit Sub
        sh.Cells.ClearContents
    End If
    sh.Range("A7") = vFileName
    sh.Range("A9:M9") = Array("シート名", "範囲", _
                            "文字色", "文字太さ", "文字傾き", "セル背景色", _
                            "Type:タイプ", "Operater:条件", "式1", "式2", _
                            "LineStyle", "Weight", "ColorIndex")
    tr = 9
    For i = 1 To wb.Sheets.Count
        For j = 1 To wb.Sheets(i).Cells.FormatConditions.Count
            With wb.Sheets(i).Cells.FormatConditions.Item(j)
                tr = tr + 1
                sh.Cells(tr, 1).Value = wb.Sheets(i).name       'シート名
                sh.Cells(tr, 2).Value = .AppliesTo.Address      '範囲
                sh.Cells(tr, 3).Value = "'&H" & _
                        Right("000000" & Hex(.Font.Color), 6)   '文字色
                sh.Cells(tr, 4).Value = .Font.Bold              '文字太さ
                sh.Cells(tr, 5).Value = .Font.Italic            '文字傾
                sh.Cells(tr, 6).Value = "'&H" & _
                    Right("000000" & Hex(.Interior.Color), 6)   'セル背景色
                sh.Cells(tr, 7).Value = .Type                   'Type
                On Error Resume Next 'エラー回避用
                sh.Cells(tr, 8).Value = .Operator               '条件
                sh.Cells(tr, 9).Value = "'" & .Formula1         '式1
                sh.Cells(tr, 10).Value = "'" & .Formula2        '式2
                With .Borders                                   '経緯線の設定
                    sh.Cells(tr, 11).Value = .LineStyle
                    sh.Cells(tr, 12).Value = .Weight
                    sh.Cells(tr, 13).Value = "'&H" & Right("000000" & Hex(.Color), 6)
                End With
                On Error GoTo 0
            End With
        Next j
    Next i
    Application.ScreenUpdating = True       '画面表示要請を解除
    MsgBox "「" & Dir(vFileName) & "」 の条件付き書式を取得しました!"
End Sub

・「12~21行目でファイルの設定が無ければダイアログを表示して開きます
・「35行目」は取得するデータの種別見出しをシートセルにセット
・「40行目」ブック内のシート数分のループ処理開始
・「41行目」条件付き書式設定がされている件数をカウントしてループ処理開始
・「42~63行目」取得した設定データをセルに書き込んでいます

「17行目」の「chkWbOpened(vFileName)」については、前回記事で「セル保存パスのブックが開いているかどうか判定する関数」として紹介していますのでご参照ください

書き出した条件付き書式設定の重複データを削除するコード【おまけ】

'書き出した条件付き書式設定の完全重複を削除する
Sub DelDuplicates()
    ActiveSheet.Range("A9").CurrentRegion.RemoveDuplicates _
            Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13), Header:=xlYes
End Sub

・書き出しておいた「条件付き書式」の設定データの重複データを削除するコードです
・同じ「条件付き書式」かどうかの判定は難しいところですが、すぐにできるものだけ削除するには「重複削除」です。(RemoveDuplicates メソッド)を使ってVBAで完全重複データを削除します
・Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13), Header:=xlYesは、
列見出しを有効にして1列目から13列目までの配列を重複チェックして削除しています
・VBAで書き出した「条件付き書式設定」の全項目を対象にして完全に重複している設定を削除しています
・列見出しの内、例えば「シート名」部分を外して重複削除を行うなどもできますが、必要に応じて修正してください

整理したセルのデータを使って「条件付き書式設定」をセットする

'セルに保存した条件付き書式設定をセット
Sub SetFormatConditions()
    Dim fc As FormatCondition
    Dim rn() As Variant
    Dim i As Long, s As Long
    Dim sh As Worksheet
    Set sh = ThisWorkbook.ActiveSheet
    Dim r As Range
    Set r = sh.Range("A10", sh.Cells(Rows.Count, 1).End(xlUp))
    If r.Count = 0 Then Exit Sub
    
    Dim vFileName As Variant
    Dim wb As Workbook
    Dim tgsh As Worksheet
    
    If sh.Range("A7").Value <> "" Then
        vFileName = sh.Range("A7").Value
    Else: vFileName = ""
    End If
    If chkWbOpened(vFileName) = False Then
        vFileName = Application.GetOpenFilename( _
                FileFilter:="Excelワークブック,*.xls?", _
                Title:="ファイルを指定して下さい", _
                MultiSelect:=False) 'true)
        If vFileName = "" Then _
                MsgBox ("未選択のため処理を中止します!"): Exit Sub
        Set wb = Workbooks.Open(vFileName)
    Else: Set wb = Workbooks(Dir(vFileName))
    End If
    sh.Activate
    Application.ScreenUpdating = False
    
    For s = 10 To r.Count + 10 - 1
        'セルから保存データを読み込む
        ReDim rn(1 To 13) As Variant
        For i = 1 To 13
            rn(i) = sh.Cells(s, i).Value
        Next i
        Set tgsh = wb.Sheets(rn(1))     'シート名
        '書式の設定(シート範囲、Type、条件、式1、式2)='Sheet1 (2)'!$N$1:$N$16
        Set fc = tgsh.Range(rn(2)).FormatConditions.Add( _
                            rn(7), rn(8), rn(9), rn(10))
        On Error Resume Next 'これ入れないとエラーで止まるので
        With fc
            With .Font                  'フォント
                .Color = rn(3)          '色
                .Bold = rn(4)           '太さ
                .Italic = rn(5)         '傾き
            End With
            .Interior.Color = rn(6)     '背景色
            With .Borders               '罫線
                .LineStyle = rn(11)     '線種
                .Weight = rn(12)        '太さ
                .Color = rn(13)         '色
            End With
        End With
    Next s
    MsgBox "「" & Dir(vFileName) & "」 に条件付き書式を設定しました!"
End Sub

・おまけ

・【33行目】条件付き書式設定数分のループ処理開始
・【36~38行目】セルから設定を配列に読み込む
・【41行目】書式の設定の(シート範囲、Type、条件、式1、式2)をセット
・【44~55行目】追加でその他の色設定や罫線などを設定する

まとめ(おわりに)

まとめと感想など

【VBAを使って整理する手順を確認します】
① 設定されている「条件付き書式」の設定をセルに書き出します
② 書き出しが終わったら「条件付き書式」の設定を全て削除します
③ 書き出した「条件付き書式」設定(範囲設定など)を整理・調整(これは手動)
④ 調整が済んだら「条件付き書式設定」をVBAでブックに反映させます
こんな感じです(^^)

記事内で紹介したコードの実行は、必ずバックアップを取ってから行ってください
大量に増殖した「条件付き書式設定」はExcelの動作を重くさせます
・不要な「条件付き書式設定」は削除することをお勧めします
・特に自分以外の人にファイルを配布する時には必ずチェックしてから配布しましょう
・また、提供いただいたファイルのチェックもしておけば安心ですね(^^)

今後の記事について

今回の記事はいかがだったでしょうか。皆さまのお役に立てたなら幸いです(^^;
是非!サンプルファイルをダウンロード出来ますのでそのまま使ってみてください(^^)/


【今後の記事内容はどうしようかなぁ・・・】
・今までに紹介した記事をリライトして「まとめ」ることを検討しています
・高速化した「VlookUp関数」のVBAでの活用法を再検討してみたいと思います
・その他「小ネタいろいろ」などなど・・・・・
・今後これらのどれかについて記事にしていきたいと思います。ご期待ください(^^)/

スポンサーリンク
スポンサーリンク

サンプルファイルをダウンロードできます(下記リンク先へ)

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