複数列ペアの重複箇所を簡単に色付け！Excelで重複データを見つけるテクニック

2024年6月9日

Excelでデータを管理する際、2つ以上の列の組み合わせで重複がある場合、その箇所を簡単に見つけたいと思ったことはありませんか？本記事では、そのようなニーズに応えるためのサンプルアプリを紹介します。このサンプルアプリを活用することで、データの重複を視覚的に確認でき、効率的なデータ管理が可能になります。

サンプルアプリの利用方法

サンプルアプリの使い方はとても簡単です。以下の手順で操作できます。
1.「重複ペア色付け」ボタンをクリックすると会社名（B列）と取引先支店名（C列）の組み合わせで重複している箇所が自動的に着色されます。色は淡い黄色、緑、シアン、ピンク、赤、青の6色が使用され、異なる重複ペアごとに異なる色でハイライトされます。
2.「着色クリア」ボタンをクリックすると、着色された箇所がクリアされ、元の状態に戻ります。

コードを作成する際のポイント

このサンプルアプリのコードを作成する際には、以下のポイントに注意しました。
1. 範囲の指定
B列とC列の範囲を明確に指定することで、特定の範囲内のデータに対して操作を行います。
2. 色の設定
淡い色を使用することで、データが見やすくなるよう工夫しています。また、色の配列を利用することで、異なる重複ペアごとに異なる色で着色します。
3. ペアの判定
会社名と取引先支店名のペアが重複しているかを判定し、重複しているペアごとに色を設定します。

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

以下にサンプルアプリのコードを示します。このコードは、重複している会社名と取引先支店名のペアを見つけて、セルを着色するためのものです。

' 変数の宣言が必須とするオプションを有効化する。
Option Explicit

Sub 重複ペア色付()

    ' ワークシート変数 ws を宣言します。
    Dim ws As Worksheet
    
    ' ワークシート変数 ws に、現在のブックの "Sheet1" を設定します（シート名は必要に応じて変更）。
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' 範囲変数 companyRange と branchRange を宣言します。
    Dim companyRange As Range
    Dim branchRange As Range
    
    ' companyRange に B5:B14 の範囲を設定します。
    Set companyRange = ws.Range("B5:B14")
    
    ' branchRange に C5:C14 の範囲を設定します。
    Set branchRange = ws.Range("C5:C14")

    ' 変数 i と j を Long 型で宣言します（ループカウンタ用）。
    Dim i As Long, j As Long
    
    ' 変数 companyName と branchName を String 型で宣言します。
    Dim companyName As String
    Dim branchName As String

    ' B列とC列の既存のハイライトをクリアします。
    companyRange.Interior.colorIndex = xlNone
    branchRange.Interior.colorIndex = xlNone

    ' 色の配列を作成します（淡い色を使用）。
    Dim colors As Variant
        
    '淡い黄色 (RGB 255, 255, 204)
    '淡い緑色 (RGB 204, 255, 204)
    '淡いシアン (RGB 204, 255, 255)
    '淡いピンク (RGB 255, 204, 255)
    '淡い赤色 (RGB 255, 204, 204)
    '淡い青色 (RGB 204, 204, 255)
    
    ' 色の配列に淡い色のRGB値を設定します。
    colors = Array(RGB(255, 255, 204), RGB(204, 255, 204), RGB(204, 255, 255), RGB(255, 204, 255), RGB(255, 204, 204), RGB(204, 204, 255))
    
    ' 色のインデックスを初期化します。
    Dim colorIndex As Integer
    colorIndex = 0

    ' ペアごとに色付けするための配列を宣言し、companyRange の行数に合わせて初期化します。
    Dim pairFound() As Boolean
    ReDim pairFound(1 To companyRange.Rows.Count)
    
    ' companyRange の各行をループします。
    For i = 1 To companyRange.Rows.Count
        ' i 行目のペアがまだ見つかっていない場合。
        If Not pairFound(i) Then
            ' i 行目の会社名と支店名を取得します。
            companyName = companyRange.Cells(i, 1).value
            branchName = branchRange.Cells(i, 1).value
            
            ' ペアが存在するかどうかを示すフラグを初期化します。
            Dim pairExists As Boolean
            pairExists = False
            
            ' companyRange の各行をループします（ペアを探す）。
            For j = 1 To companyRange.Rows.Count
            
                ' 同じ行を比較しないようにします。
                If i <> j Then
                
                    ' 同じ会社名と支店名のペアが見つかった場合。
                    If companyName = companyRange.Cells(j, 1).value And branchName = branchRange.Cells(j, 1).value Then
                    
                        ' ペアが見つかったことを記録します。
                        pairExists = True
                        
                        ' i 行目と j 行目のペアが見つかったことを記録します。
                        pairFound(i) = True
                        pairFound(j) = True
                        
                        ' i 行目と j 行目のセルに色を付けます。
                        companyRange.Cells(i, 1).Interior.Color = colors(colorIndex)
                        branchRange.Cells(i, 1).Interior.Color = colors(colorIndex)
                        companyRange.Cells(j, 1).Interior.Color = colors(colorIndex)
                        branchRange.Cells(j, 1).Interior.Color = colors(colorIndex)
                       
                    End If
                End If
            Next j
            
            ' ペアが見つかった場合、次の色に進みます。
            If pairExists Then
                colorIndex = colorIndex + 1
            End If
            
        End If
    Next i

' マクロの終了。
End Sub

'-------------------------------------------------------------------------------------------------

' ハイライトをクリアするサブルーチン
Sub 色クリア()

    ' ワークシート変数 ws を宣言します。
    Dim ws As Worksheet

    ' ワークシート変数 ws に、現在のブックの "Sheet1" を設定します（シート名は必要に応じて変更）。
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' 範囲変数 companyRange と branchRange を宣言します。
    Dim companyRange As Range
    Dim branchRange As Range

    ' companyRange に B5:B14 の範囲を設定します。
    Set companyRange = ws.Range("B5:B14")

    ' branchRange に C5:C14 の範囲を設定します。
    Set branchRange = ws.Range("C5:C14")

    ' B5:B14 の範囲内のセルの既存のハイライトをクリアします。
    companyRange.Interior.colorIndex = xlNone

    ' C5:C14 の範囲内のセルの既存のハイライトをクリアします。
    branchRange.Interior.colorIndex = xlNone

' サブルーチンの終了。
End Sub