コピペで使えるVBA!行の色を交互に塗りつぶすコード

VBA

VBAマクロで行の色を交互に塗りつぶすコードを紹介します。

塗りつぶしの方法としてInteriorオブジェクトのColorプロパティを変更します。

コードをコピーすればすぐに使えます。

コピペ前提なので短さを優先してコードを書きました。

また工夫したい方向けにアレンジするポイントも参考にしてください。

データのみ

白とグレー

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶし白とグレー()
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 255)
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(238, 238, 238)
    Next
End Sub

薄い黄色の2色

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶし薄い黄色2色()
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 238)
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 187)
    Next
End Sub

好きな2色を指定

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶし好きな2色()
    色一 = Split(InputBox(prompt:="好きな色をRGBで入力してください。デフォルトはグリーン", Default:="0,255,0"), ",")
    色二 = Split(InputBox(prompt:="好きな色をRGBで入力してください。デフォルトはレッド", Default:="255,0,0"), ",")
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(色一(0), 色一(1), 色一(2))
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(色二(0), 色二(1), 色二(2))
    Next
End Sub

ヘッダーとデータ

ネイビー、白とグレー

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶしヘッダーネイビー白とグレー()
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 255)
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(238, 238, 238)
    Next
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(1).Row, Selection(Selection.Count).Column)).Interior.Color = RGB(0, 0, 128)
End Sub

濃い黄色、薄い黄色の2色

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶしヘッダーオリーブ薄い黄色2色()
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 238)
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 187)
    Next
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(1).Row, Selection(Selection.Count).Column)).Interior.Color = RGB(128, 128, 0)
End Sub

好きな3色を指定

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶしヘッダー好きな3色()
    色ヘッダー = Split(InputBox(prompt:="好きな色をRGBで入力してください。デフォルトはピンク", Default:="255,0,255"), ",")
    色一 = Split(InputBox(prompt:="好きな色をRGBで入力してください。デフォルトはグリーン", Default:="0,255,0"), ",")
    色二 = Split(InputBox(prompt:="好きな色をRGBで入力してください。デフォルトはレッド", Default:="255,0,0"), ",")
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(色一(0), 色一(1), 色一(2))
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(色二(0), 色二(1), 色二(2))
    Next
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(1).Row, Selection(Selection.Count).Column)).Interior.Color = RGB(色ヘッダー(0), 色ヘッダー(1), 色ヘッダー(2))
End Sub

ナンバーとデータ

ネイビー、白とグレー

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶしナンバーネイビー白とグレー()
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 255)
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(238, 238, 238)
    Next
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row, Selection(1).Column)).Interior.Color = RGB(0, 0, 128)
End Sub

濃い黄色、薄い黄色の2色

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶしネイビーオリーブ薄い黄色2色()
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 238)
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 187)
    Next
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row, Selection(1).Column)).Interior.Color = RGB(128, 128, 0)
End Sub

好きな3色を指定

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶしナンバー好きな3色()
    色ヘッダー = Split(InputBox(prompt:="好きな色をRGBで入力してください。デフォルトはピンク", Default:="255,0,255"), ",")
    色一 = Split(InputBox(prompt:="好きな色をRGBで入力してください。デフォルトはグリーン", Default:="0,255,0"), ",")
    色二 = Split(InputBox(prompt:="好きな色をRGBで入力してください。デフォルトはレッド", Default:="255,0,0"), ",")
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(色一(0), 色一(1), 色一(2))
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(色二(0), 色二(1), 色二(2))
    Next
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row, Selection(1).Column)).Interior.Color = RGB(色ヘッダー(0), 色ヘッダー(1), 色ヘッダー(2))
End Sub

ヘッダーとナンバーとデータ

ネイビー、白とグレー

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶしヘッダーナンバーネイビー白とグレー()
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 255)
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(238, 238, 238)
    Next
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(1).Row, Selection(Selection.Count).Column)).Interior.Color = RGB(0, 0, 128)
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row, Selection(1).Column)).Interior.Color = RGB(0, 0, 128)
End Sub

濃い黄色、薄い黄色の2色

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶしヘッダーナンバーオリーブ薄い黄色2色()
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 238)
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 187)
    Next
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(1).Row, Selection(Selection.Count).Column)).Interior.Color = RGB(128, 128, 0)
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row, Selection(1).Column)).Interior.Color = RGB(128, 128, 0)
End Sub

好きな3色を指定

セルA1:E5を選択してマクロを実行

A B C D E
1
2
3
4
5

実行後

A B C D E
1
2
3
4
5

Sub 塗りつぶしヘッダーナンバー好きな3色()
    色ヘッダー = Split(InputBox(prompt:="好きな色をRGBで入力してください。デフォルトはピンク", Default:="255,0,255"), ",")
    色一 = Split(InputBox(prompt:="好きな色をRGBで入力してください。デフォルトはグリーン", Default:="0,255,0"), ",")
    色二 = Split(InputBox(prompt:="好きな色をRGBで入力してください。デフォルトはレッド", Default:="255,0,0"), ",")
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(色一(0), 色一(1), 色一(2))
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(色二(0), 色二(1), 色二(2))
    Next
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(1).Row, Selection(Selection.Count).Column)).Interior.Color = RGB(色ヘッダー(0), 色ヘッダー(1), 色ヘッダー(2))
    Range(Cells(Selection(1).Row, Selection(1).Column), Cells(Selection(Selection.Count).Row, Selection(1).Column)).Interior.Color = RGB(色ヘッダー(0), 色ヘッダー(1), 色ヘッダー(2))
End Sub

アレンジするポイント

カンマ以外の区切り文字を使う

金と銀に変える場合RGBで色を指定する。
金=RGB(255, 215, 0)
銀=RGB(192, 192, 192)

Sub 塗りつぶし白とグレー()
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 255, 255)
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(238, 238, 238)
    Next
End Sub

変更後

Sub 塗りつぶし白とグレー()
    For R = Selection(1).Row To Selection(Selection.Count).Row
        If R Mod 2 <> 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(255, 215, 0)
        If R Mod 2 = 0 Then Range(Cells(R, Selection(1).Column), Cells(R, Selection(Selection.Count).Column)).Interior.Color = RGB(192, 192, 192)
    Next
End Sub

コメント

タイトルとURLをコピーしました