EXCEL VBA 自由に選択範囲の重複データのハイライト表示・重複件数により色分け(テクニック)
EXCEL VBA 自由に選択範囲の重複データのハイライト表示・重複件数により色分け(テクニック)
今回説明するサンプルプログラムは、Excelのワークシートで選択された範囲内のセルについて、重複する値を持つセルを黄色でハイライトする機能を持っています。事務業務においては、顧客リストや商品リストなどのデータで重複を素早く識別する際に役立ちます。たとえば、顧客データベースで重複する顧客名を見つけ出し、データの整合性を保つためのクリーニング作業を効率化することができます。また、在庫管理においても同一商品の重複エントリーを発見するのに使用できます。このように、データの重複を視覚的に確認しやすくすることで、データの品質管理やエラーの検出を効率的に行うことが可能になります。
●【EXCEL VBA 選択セル・選択行・列 フォントカラーでハイライト表示(強調)、下記を参照して下さい】
●【EXCEL VBA 選択セル・選択行・列 ハイライト表示、下記を参照して下さい】
●【Worksheet.SelectionChange イベント (Excel)、下記を参照して下さい】(Microsoft社 様)】
https://learn.microsoft.com/ja-jp/office/vba/api/excel.worksheet.selectionchange
Excel VBAで重複データを簡単に見つける方法:VBAマクロを使ったセルの自動ハイライト機能の紹介
今回説明するサンプルプログラムExcel内で選択された範囲内のセルを走査し、重複する値を持つセルを黄色でハイライトするプログラムです。具体的には、選択範囲内の各セルの値をチェックし、それぞれの値が何回出現するかをカウントします。その後、出現回数が1より大きい(つまり重複している)セルの背景色を黄色に変更します。
※マウスでEXCELのセル範囲を指定して、指定した範囲内で自動的に重複セルを検索して該当セルの背景色を黄色に塗りつぶします。
【プログラムの流れ】
- ユーザーがセル範囲を選択すると、Worksheet_SelectionChangeイベントがトリガーされます。
- スクリプト辞書オブジェクトが作成されます。
- 選択された範囲が変数
rng
に設定されます。 - 選択範囲内の各セルに対してループを行い、空でないセルの値を辞書に記録し、出現回数をカウントします。
- 再度、選択範囲内の各セルに対してループを行い、出現回数が1より大きいセルを黄色でハイライトします。
- 辞書オブジェクトが解放されます。
【プログラム実行条件・注意事項】
- このマクロはセル範囲が変更されるたびに自動的に実行されるため、大きな範囲を選択すると処理が遅くなる可能性があります。
- このマクロは選択されたセル範囲内のみで動作し、ワークシート全体の重複をチェックするわけではありません。
- マクロを実行すると、以前に設定されたセルの色がクリアされます。そのため、色情報は失われます。★注意:下記のプログラムを実行するには、ワークシートプロシージャの「Worksheet」・「SelectionChange」に登録する。
★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
● duplicatecolorcoding01(サンプルプログラム)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 |
’ ’ Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range Dim cell As Range Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") ' 辞書オブジェクトの作成 ' 選択範囲を変数rngに設定 Set rng = Selection ' 選択範囲が1つのセルのみの場合は何もしない If Target.Cells.CountLarge = 1 Then Exit Sub ' 以前にハイライトされたセルの色をクリア Cells.Interior.ColorIndex = xlNone ' 選択範囲内のセルの値を辞書に記録し、出現回数をカウント For Each cell In rng If Not cell.Value = "" Then ' 空のセルは無視 If dict.Exists(cell.Value) Then dict(cell.Value) = dict(cell.Value) + 1 ' 既にキーが存在する場合はカウントアップ Else dict(cell.Value) = 1 ' 新しいキーを辞書に追加 End If End If Next cell ' 重複があるセルをハイライト For Each cell In rng If Not cell.Value = "" Then If dict(cell.Value) > 1 Then cell.Interior.Color = RGB(255, 255, 0) ' 出現回数が1より大きいセルを黄色でハイライト End If End If Next cell ' 辞書オブジェクトの解放 Set dict = Nothing End Sub ’ |
(画面クリックして拡大)
Excel VBAでデータ重複を即座に視覚化!選択範囲に応じた色の変更で重複をハイライトするVBAマクロの作成方法
下記のサンプルプログラムは、Excelのワークシートにおいて、ユーザーが新しいセル範囲を選択するたびに実行されるイベントベースのマクロです。具体的には、ユーザーがA1からG1000までの範囲内でセルを選択した際に、その選択範囲内のセルの値をチェックし、重複している値を持つセルを異なる色でハイライトします。重複の度合いに応じて色が変わり、2回の重複は青色、3回から5回の重複は黄色、6回以上の重複は赤色でハイライトされます。
【プログラムの流れ】
- ユーザーがセルを選択すると、
Worksheet_SelectionChange
イベントがトリガーされます。 - A1からG1000までの範囲を
CheckRange
として設定します。 - ユーザーが選択した範囲が
CheckRange
と交差しない場合、処理は終了します。 CheckRange
内のセルのハイライトをクリアします。- 選択された範囲内の各セルについて、そのセルの値が空でない場合、その値の出現回数をカウントします。
- カウントした結果を基に、重複している値を持つセルを色付けします。重複の回数に応じて色が決定されます。
- 辞書オブジェクトをクリアして処理を終了します。
【プログラム実行条件・注意事項】
- このマクロはワークシート上でセル範囲が変更されるたびに実行されるため、大きな範囲を選択したり、頻繁にセルを選択するとパフォーマンスに影響を与える可能性があります。
Worksheet_SelectionChange
イベントはセル選択の変更時にのみ発生するため、セルの内容が変更されても自動的には更新されません。- 辞書オブジェクトを使用しているため、このコードはExcelのバージョンが辞書オブジェクトに対応している必要があります。
ColorIndex
を使用している箇所はxlNone
に設定されていますが、他の色を使用する場合はColorIndex
の値を適切に設定する必要があります。★注意:下記のプログラムを実行するには、ワークシートプロシージャの「Worksheet」・「SelectionChange」に登録する。
★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
● duplicatecolorcoding02 (サンプルプログラム)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 |
’ ’ Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' A1からG1000の範囲をチェック範囲として設定 Dim CheckRange As Range Set CheckRange = Me.Range("A1:G1000") ' 選択された範囲がチェック範囲外ならば処理を終了 If Intersect(Target, CheckRange) Is Nothing Then Exit Sub ' チェック範囲内のセルのハイライトをクリア CheckRange.Interior.ColorIndex = xlNone Dim cell As Range Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") ' 選択された範囲内のセルの値を辞書に記録し、出現回数をカウント For Each cell In Intersect(Target, CheckRange) If Not cell.Value = "" Then ' 空のセルは無視 If dict.Exists(cell.Value) Then dict(cell.Value) = dict(cell.Value) + 1 Else dict(cell.Value) = 1 End If End If Next cell ' 重複値を持つセルに色を付ける。色は重複の回数によって決定される。 For Each cell In Intersect(Target, CheckRange) If Not cell.Value = "" And dict.Exists(cell.Value) Then Select Case dict(cell.Value) Case 2 cell.Interior.Color = RGB(0, 0, 255) ' 重複が2回の場合は青色でハイライト Case 3 To 5 cell.Interior.Color = RGB(255, 255, 0) ' 重複が3回から5回の場合は黄色でハイライト Case Is >= 6 cell.Interior.Color = RGB(255, 0, 0) ' 重複が6回以上の場合は赤色でハイライト End Select End If Next cell ' 辞書オブジェクトの参照を解放 Set dict = Nothing End Sub ’ ’ |
(画面クリックして拡大)
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。