[[20211207103406]]　『条件付書式マクロ　特定の列の色を変えたい』（りの）　ページの最後に飛ぶ

『条件付書式マクロ　特定の列の色を変えたい』（りの）

下記、M3からAU3行の中で数字1（weekday関数にて表示する）が
存在すれば、そこから同じ列の5行目から10行目まで色をつけるマクロを
作りたいのですが、エラーになってしまいます。
どこがおかしいかわかるかたご指摘いただけないでしょうか。

条件付書式を入れれば簡単なのですが、データ量が多めなので
全シートに設定すると一気にデータが重くファイルが固まってしまうため
マクロで色づけしたいと思っています。

また、途中で色をつけずにその下の行の色付けを同時に場合は
どうすればよろしいのでしょうか？
（例えば5行目から10行目までと15行目から20行目までなど）

恐縮ですがよろしくお願い致します。

Sub 日曜日色づけ()

    With Range("M3:AU3").FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="1")

        Range(offset(5, 0), offset(10, 0)).Interior.Color = RGB(255, 204, 103)
    End With

End Sub

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

条件付き範囲の適用範囲の工夫で解決しそうな気もしますが、それはさておき

 Sub 日曜日色づけ()
    Dim r As Range
    Dim iPattern As Long
    For Each r In Range("M3:AU3")           'M3:AU3の範囲のセルについて
        If r.Value = 1 Then                 '値が1なら
            iPattern = xlSolid              '塗りつぶす設定ON
        Else                                '値が1以外なら
            iPattern = xlNone               '塗りつぶす設定OFF
        End If
        With r.Offset(2).Resize(6).Interior '3行目の2行下から6行（=5行目から10行目）の範囲について
            .Pattern = iPattern             '塗りつぶす設定を適用
            If iPattern <> xlNone Then      '塗りつぶす設定がOFFでない場合は
                .Color = RGB(255, 204, 103) '指定の色にする
            End If
        End With
    Next
 End Sub
（きまぐれおじさん） 2021/12/07(火) 11:04

 r.Offset(2).Resize(6)
↓
 Intersect(r.EntireColumn, Range("5:10,15:20"))

こんな風にすると飛び飛びの行の指定が可能です。
（きまぐれおじさん） 2021/12/07(火) 11:08

 Sub 条件付き書式で()
    With Intersect(Range("M:AU"), Range("5:10,15:20")).FormatConditions
        '古い条件付き書式を削除
        .Delete
        '新しく条件付き書式を設定
        .Add(Type:=xlExpression, Formula1:="=M$3=1").Interior.Color = RGB(255, 204, 103)
    End With
 End Sub

ついでに条件付き書式でやる方も
（きまぐれおじさん） 2021/12/07(火) 11:17

 Sub 全シートに条件付き書式()
    Dim ws As Worksheet
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Sheet1", "Sheet2" '除外するシート名
            Case Else
                With Intersect(ws.Range("M:AU"), ws.Range("5:10,15:20")).FormatConditions
                    '古い条件付き書式を削除
                    .Delete
                    '新しく条件付き書式を設定
                    .Add(Type:=xlExpression, Formula1:="=M$3=1").Interior.Color = RGB(255, 204, 103)
                End With
        End Select
    Next
 End Sub

おまけのおまけで全シート（除外シート設定あり）に同じ条件付き書式を設定するコードも
（きまぐれおじさん） 2021/12/07(火) 11:35

きまぐれおじさんさん

ありがとうございます！

ちなみに他の列にもすでに別な色がいろいろ入っておりまして、
↓下記ですと1以外の部分が白くなってしまいますが
そのままの色を生かす（色づけは実施しない）こと可能でしょうか？

        Else                                '値が1以外なら
            iPattern = xlNone               '塗りつぶす設定OFF

また、飛び飛びのパターンにて実施すると

.Pattern = iPattern のところでエラーが発生してしまいます。

併せて恐縮ですがご教示お願い致します。

（りの） 2021/12/07(火) 12:42

 Sub 日曜日色づけ()
    Dim r As Range
    For Each r In Range("M3:AU3")
        If r.Value = 1 Then
            With Intersect(r.EntireColumn, Range("5:10,15:20")).Interior
                .Pattern = xlSolid          '塗りつぶす
                .Color = RGB(255, 204, 103) '指定の色にする
            End With
        End If
    Next
 End Sub

背景色の上塗りだけならもう少し簡単になりますが、色塗りを外すのは手動になります。
（きまぐれおじさん） 2021/12/07(火) 12:58

きまぐれおじさんさん

ご教示ありがとうございます！解決できました。

（りの） 2021/12/07(火) 13:09

コメント返信：

[ 一覧(最新更新順) ]

[[20211207103406]] 『条件付書式マクロ 特定の列の色を変えたい』（りの） ページの最後に飛ぶ

[[20211207103406]]　『条件付書式マクロ　特定の列の色を変えたい』（りの）　ページの最後に飛ぶ