[Excel][VBA]上下で列を比較し、同じであれば色を付ける

仕事中に書いたExcelマクロをメモ。

上下でセルを比較し、同じであれば色を付ける。
このとき、連続する値が切り替わったとき、分かりやすいように赤と黄色で交互に色を付ける。
例えば以下のような表があったとすると

マクロ処理前

マクロ処理前

処理後は以下のようになる。

マクロ処理後

マクロ処理後


aaaは連続するので黄色、その後bbbも連続しているが、上のaaaと区別しやすいように色を変える。
cccは連続しないので色付けなし。
色は黄色、赤と切り替えていく。

ソースファイルは以下

Sub Macro1()
'上の行と比較して、列Aの値が同じであれば色を付けるマクロ
'連続する値が変わると、背景色を変える

    Dim coler As Integer      '色フラグ
    Dim flg As Integer        '連続フラグ
    Dim row As Long           '現在行
    
    Dim p_row_value As String '1行前のセルの値
    Dim n_row_value As String '現在行のセルの値
    
    '各変数の初期化
    p_row_value = ""
    n_row_value = ""
    coler = 0
    flg = 0
    
    '最終行まで繰り返す
    Dim i As Long
    For row = 1 To Cells(Rows.Count, 1).End(xlUp).row
    
        '現在行列Aの値を取得
        n_row_value = Cells(row, 1).Value
        
        '上の行と値が同じであれば色を付ける
        If n_row_value = p_row_value Then
               
            '連続が途切れた場合はカラーフラグを変更
            If flg = 0 Then
                '0なら1に、1なら0に
                coler = (coler + 1) Mod 2
            End If
                
        flg = 1  '連続フラグON
            
        Cells(row - 1, 1).Interior.Color = f_coler(coler) '上の行B列の色を変更
        Cells(row, 1).Interior.Color = f_coler(coler)     '現在行B列の色を変更
           
        Else
           flg = 0  '連続フラグOFF
        End If
        
        '現在行列Bの値をセット
        p_row_value = n_row_value
        
    Next row
    
    '完了表示
    MsgBox ("処理が完了しました。")

End Sub

Function f_coler(flg As Integer) As Long
    If flg = 0 Then
        'フラグが0であれば赤を返す
        f_coler = RGB(255, 0, 0)
    Else
        'フラグが1であれば黄を返す
        f_coler = RGB(255, 255, 0)
    End If
End Function

ちなみに、ループの条件は

For row = 1 To Cells(Rows.Count, 1).End(xlUp).row

列Aを最終行からさかのぼって、最初に値がある行まで。
これで途中が空白セルで抜けてても、最終行までチェックできる。

ついでにもう一個。
これはメモ。

Sub Macro2()

    Dim coler As Integer     '色
    Dim flg As Integer        '連続フラグ
    Dim row As Long           '現在行
    Dim s_row As Long         '開始行
    Dim e_row As Long         '終了行
    
    Dim p_row_value As String '1行前のセルの値
    Dim n_row_value As String '現在行のセルの値
    
    Dim i As Long             'ループ用カウンタ
    
    '各変数の初期化
    p_row_value = ""
    n_row_value = ""
    coler = 0
    flg = 0
    
    '最終行まで繰り返す
    For row = 1 To Cells(Rows.Count, 1).End(xlUp).row
        n_row_value = Cells(row, 1).Value
        
        '上の行と値が同じ時の処理
        If n_row_value = p_row_value Then
                
            '新たに連続が始まるときは連続の開始行を取得
            If flg = 0 Then
                coler = (coler + 1) Mod 2
                s_row = row - 1
            End If
            
            flg = 1  '連続フラグON
        
        
        '上の行と値が違う時の処理
        Else
            '連続が途切れたら連続の終了行を取得し表示処理
            If flg = 1 Then
                e_row = row - 1 '終了行の取得
                Call s_check(s_row, e_row) '表示処理
            End If
            
            '1行だけの場合は列bの値を見て、Yなら列cにYYを表示
            If Cells(row, 2).Value = "Y" Then
                Cells(row, 3).Value = "YY"
            End If
            
            flg = 0  '連続フラグOFF
            
        End If
        
        '現在行列Bの値をセット
        p_row_value = n_row_value
        
    Next row
    
    '完了表示
    MsgBox ("処理が完了しました。")

End Sub


Sub s_check(s As Long, e As Long)
'連続する行s〜eの列Eの値をチェックし、結果を列Hに表示する
'引数 s : 開始行
'引数 e : 終了行

    Dim i As Long
    Dim ii As Long
    Dim Yno As Long
    
    'Yが存在する行数の初期化
    Yno = 0
    
    行sから行eをチェック
    For i = s To e
        If Cells(i, 2).Value = "X" Then
        ElseIf Cells(i, 2).Value = "Y" Then
            'Yが存在すればその行数を保持
            Yno = i
        End If
    Next
    
    
    'Yが存在しなければ何もしない
    If Yno = 0 Then
    
    'Yが存在する行が最後
    ElseIf Yno = e Then
        For ii = s To e
            '行sから行eに削除を表示
            Cells(ii, 2) = "YY"
        Next ii
        
    'Yが存在する行が最後でない
    Else
        For ii = s To e
            '行sから行eにoutputを表示
            Cells(ii, 2) = "XX"
        Next ii
        
    End If
    
End Sub
  1. まず、列Aを上から見ていき、連続する値があるか調べる。
  2. 連続する値があれば、連続の開始行と終了行を取得する。
  3. 開始と終了の間の列Bをチェック
    • すべてXであれば何もしない。
    • Yが存在し、最終行がXであれば列Cの開始〜終了行までXXを表示
    • Yが存在し、最終行もYであれば列Cの開始〜終了行までYYを表示
  4. 単一行であれば、行Bをチェックし、Yのときのみ列CにYYを表示

実行前後のイメージはこんな感じ。

マクロ処理前

マクロ処理前


マクロ処理後

マクロ処理後

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です