エクセルで選択した3つの表を比較して重複セルの色を変えるマクロボタンを作る方法

エクセル

2024.05.27

あなたはエクセルの表で重複チェックするのが面倒だと思ったことはありませんか？

商品のデータをチェックしたり、統計データを比較したり、見比べてチェックするのは大変ですよね。

表が２つなら目視でがんばれても、３つあったら、もう大変です。

エクセルのマクロを使えば、比べる表が３つあっても、重複チェックが簡単にできます。

今回は「エクセルで選択した３つの表を比較して重複セルの色を変えるマクロボタンを作る方法」を紹介します。

エクセルで選択した３つの表を比較して重複セルの色を変えるマクロボタンを作る方法
確認
まとめ

エクセルで選択した３つの表を比較して重複セルの色を変えるマクロボタンを作る方法

エクセルで選択した３つの表を比較して重複セルの色を変えるマクロボタンを作る方法です。

今回は、下のような３つの表で重複チェックする例を紹介します。

マクロを作るときは、「開発」タブを使います。
開発タブが出ていない方は、下のリンクで出し方を紹介していますので、まずは準備をお願いします。
→エクセルで開発タブを表示する方法

１．「開発」タブをクリック　→「挿入」をクリック　→「ボタン」をクリック

２．「新規作成」をクリック

３．コード入力画面が開く

４．コードを入力

コードを入力します。

３つの表の選んで、重複を確認して、重複箇所を黄色にする、という意味です。

赤枠部のコードです。

    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim cell1 As Range
    Dim cell2 As Range
    Dim cell3 As Range
    Dim duplicateCount As Integer
    Dim foundDuplicate As Boolean
    
    ' ユーザーに最初の範囲を選択させる
    On Error Resume Next
    Set rng1 = Application.InputBox("比較する最初の表を選択してください:", "表1の選択", Type:=8)
    On Error GoTo 0
    
    If rng1 Is Nothing Then
        MsgBox "表1が選択されていません。マクロを終了します。", vbExclamation
        Exit Sub
    End If
    
    ' ユーザーに2番目の範囲を選択させる
    On Error Resume Next
    Set rng2 = Application.InputBox("比較する2番目の表を選択してください:", "表2の選択", Type:=8)
    On Error GoTo 0
    
    If rng2 Is Nothing Then
        MsgBox "表2が選択されていません。マクロを終了します。", vbExclamation
        Exit Sub
    End If
    
    ' ユーザーに3番目の範囲を選択させる
    On Error Resume Next
    Set rng3 = Application.InputBox("比較する3番目の表を選択してください:", "表3の選択", Type:=8)
    On Error GoTo 0
    
    If rng3 Is Nothing Then
        MsgBox "表3が選択されていません。マクロを終了します。", vbExclamation
        Exit Sub
    End If
    
    ' 重複のカウントをリセット
    duplicateCount = 0
    
    ' 最初の範囲内の各セルをループ
    For Each cell1 In rng1
        ' 2番目の範囲内の各セルと比較
        For Each cell2 In rng2
            If cell1.Value = cell2.Value And cell1.Value <> "" Then
                ' 3番目の範囲内の各セルと比較
                foundDuplicate = False
                For Each cell3 In rng3
                    If cell1.Value = cell3.Value Then
                        ' 重複している場合、セルを黄色にする
                        cell1.Interior.Color = RGB(255, 255, 0)
                        cell2.Interior.Color = RGB(255, 255, 0)
                        cell3.Interior.Color = RGB(255, 255, 0)
                        duplicateCount = duplicateCount + 1
                        foundDuplicate = True
                        Exit For
                    End If
                Next cell3
                If foundDuplicate Then Exit For
            End If
        Next cell2
    Next cell1
    
    ' 重複の数をメッセージボックスで表示
    MsgBox "重複したセルは " & duplicateCount & " 件ありました。", vbInformation

コードを入力したら、コードの入力画面を閉じて下さい。

５．ボタンができた　→ボタンをクリック

ボタンができたら、ボタンをクリックします。