【Excelマクロ】仕訳データなどを特定の列の値によって色を塗り分ける

テーマは行の塗り分けマクロ Excelの話

Excelのマクロで仕訳データなどを仕訳番号などの特定の列の値によって色を塗り分けるマクロです。
キーとなる特定の列が変わるごとに色を塗る、塗らないを交互にすることで仕訳データを仕訳番号ごとに見やすくすることができます。

For~NextとIFとInterior.ColorIndexで実現

簡潔にするため、塗り分けのスタートは2行目からで固定しています。

キーとなる特定の列については入力ボックス(Application.InputBox)で数字で指定します。(11行目)
また塗り分けする列についても入力ボックスを使って入力した列数までとしています。(12行目)

塗り分ける色は22行目と24行目の数字を変更すれば色が変更可能です。

Sub row_color()

Dim last_row As Long
Dim last_col As Long
Dim key_col As Long
Dim START_ROW As Long: START_ROW = 2
Dim START_COL As Long: START_COL = 1
Dim r As Long
Dim color_flg As Long:color_flg = 0

key_col = Application.InputBox("判定列は何列目?(A列なら1、D列なら4。半角で)", "判定列", "", , , , , 1)
last_col = Application.InputBox("何列目まで色を塗るか?(I列までなら8など。半角で)", "塗り分け範囲", "", , , , , 1)
last_row = Cells(Rows.Count, 1).End(xlUp).Row

For r = START_ROW To last_row
    '上の行と値が違ったらcolor_flgを加算
    If Cells(r - 1, key_col) <> Cells(r, key_col) Then
        color_flg = color_flg + 1
    End If
    'color_flgの値が偶数ならその行を水色(35)に奇数なら塗りつぶしなし(0)にする
    If color_flg Mod 2 = 0 Then
       Range(Cells(r, START_COL), Cells(r, last_col)).Interior.ColorIndex = 35
    Else
       Range(Cells(r, START_COL), Cells(r, last_col)).Interior.ColorIndex = 0
    End If
Next

End Sub

17、18行目でキーとなる列の値が上の行と同じかどうかを判定しています。

マクロを実行するとこうなります。

こういう仕訳データを例にマクロを実行してみます。B列(2列目)の伝票番号をキーにG列(7列目)までを塗り分けます。

塗り分けマクロ実行前

マクロを実行すると、InputBoxが表示されるので、判定列はB列なので2、塗り分ける列はG列までなので7を入力します。

インプットボックスの入力画面

すると、こういう感じに塗り分けてくれます。

塗り分けマクロ実行後

仕訳データなどの会計データなどを明細ごとに見やすくするのに役立つマクロです。

塗り分ける色などはお好みでカスタマイズしてご利用ください。

コメント

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