仕訳データなどの重複データに色を付けるマクロを作ってみた件。（ChatGPT活用）

Private Sub CommandButton1_Click()

'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
'【マクロの概要】
'ユーザーフォーム上で選択した「見出し（タイトル）」に対応する列をもとに、「重複チェック」シート上の重複データを検出し、
'重複しているすべての行（最初に出現した行も含む）に黄色で行全体の色を付けます。
'処理の前には、前回の色付けをすべてクリアするので、繰り返し実行しても問題ありません。
'
'― 利用例：
'　氏名＋生年月日など、任意の複数列を選択して「同じ人物」をチェックしたい場合などに便利です。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

    '＝ 使用する変数の宣言 ＝
    Dim dict As Object                      ' 重複チェック用のDictionaryオブジェクト
    Dim i As Long, j As Long                ' 行ループ(i)・ListBoxループ(j)用のカウンタ
    Dim lastrow As Long                     ' 名簿シートの最終行を取得する変数
    Dim ws As Worksheet                     ' 対象となる「重複を確認する」シート
    Dim selectedCols As Collection          ' ユーザーフォームで選択された列番号の一覧を保持
    Dim serch_words As String               ' 重複チェック用の連結文字列（検索キー）
    Dim colIndex As Variant                 ' 選択された各列の列番号（For Each で使うのでVariant型）
    Dim headerText As String                ' ユーザーフォームで選択された見出しのテキスト

    '＝ 名簿シートの設定と最終行の取得 ＝
    Set ws = Worksheets("重複チェック")
    lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    '＝ Dictionaryと選択列のコレクションを初期化 ＝
    Set dict = CreateObject("Scripting.Dictionary")
    Set selectedCols = New Collection

    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    '― ListBoxで選ばれた見出しから、対応する列番号（1,2,3,...）を取得して保存
    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    
    For j = 0 To Me.ListBox1.ListCount - 1
    
        If Me.ListBox1.Selected(j) Then
        
            headerText = Me.ListBox1.List(j)
            '― シートの５行目から同じ見出しを探し、列番号を取得
            For colIndex = 1 To ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
            
                If ws.Cells(5, colIndex).Value = headerText Then
                
                    selectedCols.Add colIndex
                    
                    Exit For
                    
                End If
                
            Next colIndex
            
        End If
        
    Next j

    '＝ 前回の実行で塗られた色を全行からクリア ＝
    ws.Rows("6:" & lastrow).Interior.ColorIndex = xlColorIndexNone
    
    

    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    '― 6行目から下を順に処理し、検索キーを作成して重複チェック
    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
   
   
   For i = 6 To lastrow
        serch_words = ""
        For Each colIndex In selectedCols
            '― 選択列の値を連結してキーにする（Trimで前後の空白も除去）
            serch_words = serch_words & "_" & Trim(ws.Cells(i, colIndex).Text)
        Next colIndex

        If dict.exists(serch_words) Then
        
            '― すでに同じキーがある ⇒ 現在行＆元の行どちらにも色を付ける
            ws.Rows(i).Interior.ColorIndex = 6
            ws.Rows(dict(serch_words)).Interior.ColorIndex = 6
            
        Else
        
            '― 初めてのキー ⇒ 行番号をDictionaryに記録
            dict.Add serch_words, i
            
        End If
        
    Next i

    '＝ 完了メッセージ表示 ＝
    MsgBox "重複しているすべての行に色を付けました。", vbInformation

    '＝ ユーザーフォームを閉じる ＝
    Unload Me

End Sub

Private Sub UserForm_Initialize()


'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
'【マクロの概要】
'
' このユーザーフォームが開かれたときに実行される初期化処理です。
' 「重複チェック」シートの1行目にある各列の「見出し（タイトル）」を取得して、
' ListBox（ListBox1）に一覧として追加します。
'
' ユーザーはこのListBoxから複数の見出しを選択できるようになっており、
' 後続の重複チェック処理に使用される対象列を柔軟に選べる仕組みになっています。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

    '＝ 変数の宣言 ＝
    Dim ws As Worksheet           ' 名簿シートを参照するためのオブジェクト変数
    Dim lastCol As Long           ' ５行目で使われている最終列番号を格納する変数
    Dim i As Long                 ' 列ループ用カウンタ
    Dim headerText As String      ' 各列の見出し（セルの値）を格納する変数

    '＝ 名簿シートをセット ＝
    Set ws = ThisWorkbook.Worksheets("重複チェック")

    '＝ 5行目の最終列を取得 ＝
    lastCol = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column

    '＝ ListBoxを初期化（前回のデータが残らないように） ＝
    Me.ListBox1.Clear

    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    '― 名簿シート５行目の見出しを、ListBox1 に追加していく（空欄は除く）
    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    For i = 1 To lastCol
    
        headerText = ws.Cells(5, i).Value

        If headerText <> "" Then
        
            '― 見出しテキストが空でなければ、ListBox に追加
            Me.ListBox1.AddItem headerText
            
        End If
        
    Next i

    '＝ ListBoxの複数選択を有効化（複数列の指定を可能に） ＝
    Me.ListBox1.MultiSelect = fmMultiSelectMulti

End Sub

Sub showDuplicateChecker()
    ' ユーザーフォームを表示
    UserForm1.Show
    
End Sub