ExcelVBAを使って重複箇所のセルに色を付ける

2023年4月15日

Excelでデータを整理する際、重複箇所に色を付けることで可視化することができます。そのため、条件付き書式を設定することが一般的に行われますが、膨大なデータがある場合は手間がかかります。こういった場合に、VBAを使うことで処理を自動化できます。今回ご紹介するサンプルアプリでは、重複した2番目以降のデータに色を付けます。

サンプルアプリ実行動作

「重複箇所色付け」ボタンをクリックすると重複箇所に色が付きます。

サンプルコードの処理内容

処理の内容については以下の通りです。
Dictionary(連想配列)オブジェクトを使ってオブジェクト変数にデータをセットしていきます。データをセットするにあたり、すでにオブジェクト変数内に存在するデータであればデータをセットせずにセルに色を付けます。オブジェクト変数内に存在しないデータであれば追加していきます。セルに色を付けるかどうかは、オブジェクト変数内に該当のデータが存在するかで判断していきます。
メソッド、プロパティについては以下のリンク先をご覧ください。
Dictionary オブジェクト

なお、サンプルアプリでは、セルを着色する際に「Interior.ColorIndex = 40」としていますが、カラー番号の一覧は以下の通りです。


【処理内容】

各ワークシートオブジェクトの取得
　　　　　↓
各種変数の定義
　　　　　↓
Dictionary(連想配列)オブジェクトの宣言
　　　　　↓
オブジェクト型変数にDictionary(連想配列)オブジェクトを格納
　　　　　↓
データ部分の最終行の行番号を取得
　　　　　↓
データ範囲をループ処理
　　　　　↓
Dictionaryオブジェクト内に同じデータがあればセルを着色
同じデータがなければDictionaryオブジェクトにデータ追加
　　　　　↓
データ範囲をループ処理
　　　　　↓
Dictionaryオブジェクトリセット
　　　　　↓
処理完了メッセージの表示

サンプルコード　　アプリの作成手順はこちら

Option Explicit

Sub 重複データ色付け()
  'ワークシートを指定する
   Dim Sh1 As Worksheet
   Set Sh1 = ThisWorkbook.Worksheets("Sheet1")

  '変数を定義します。
   Dim Dic, i As Long, K As Long, buf As String
 
  'Dictionaryオブジェクトの宣言
   Set Dic = CreateObject("Scripting.Dictionary")

  'データの最終行を取得
   K = Sh1.Cells(Rows.Count, 2).End(xlUp).Row
   
  'データ範囲(５行目～データ最終行)を上から順番にループ処理でチェック
   For i = 5 To K
    buf = Sh1.Cells(i, 2).Value
       
   '同じデータがあれば
    If Dic.Exists(buf) Then
    
     'セルに色を着色
      Sh1.Cells(i, 2).Interior.ColorIndex = 40
      
    Else

     '同じデータがなければDictionaryオブジェクトにデータ追加
      Dic.Add buf, buf
      
    End If
    
   Next i
   
  'Dictionaryオブジェクトリセット
   Set Dic = Nothing

  '完了メッセージの表示
   MsgBox "処理が完了しました。"

End Sub


VBA,セルの操作,ループ処理Excel,VBA,サンプルアプリ,マクロ,重複データ

Posted by CoderM