【VBA】テーブル内の重複チェック

テーブル内に重複があるかを確認する

'重複があったらfalseを返す
Function 重複チェック(ws As Worksheet, tbl As ListObject) As Boolean
On Error GoTo ERROR_HANDLER
    Dim rng As Range
    Dim row1 As ListRow, row2 As ListRow
    Dim col As ListColumn
    Dim cell1 As Range, cell2 As Range
    Dim duplicateFound As Boolean
    
    ' テーブルのデータ範囲を取得
    Set rng = tbl.DataBodyRange
    
    ' 各行の重複をチェック
    For Each row1 In tbl.ListRows
        For Each row2 In tbl.ListRows
            If row1.Index < row2.Index Then ' 同じ行以前のものは比較しないように
                ' すべての列が一致するか確認
                duplicateFound = True
                For Each col In tbl.ListColumns
                    Set cell1 = row1.Range.Cells(col.Index)
                    Set cell2 = row2.Range.Cells(col.Index)
                    If cell1.Value <> cell2.Value Then
                        duplicateFound = False
                        Exit For
                    End If
                Next col
                
                ' 重複が見つかった場合、メッセージを表示
                If duplicateFound = True Then
                    MsgBox "重複が見つかりました。行 " & row1.Index & " と行 " & row2.Index, vbExclamation, "重複チェック"
                    重複チェック = False
                    Exit Function ' 一度重複が見つかったら終了
                End If
            End If
        Next row2
    Next row1
    重複チェック = True
Exit Function '重要:エラーハンドラに入る前にExitする
ERROR_HANDLER:
    errNumber = Err.Number
    On Error GoTo 0
    
    MsgBox "重複チェックエラー", vbCritical, "重複チェックに失敗しました"

    ' 呼び出し元にエラーを伝達します
    Call Err.Raise(errNumber)
End Function

2つのテーブル間に重複するデータがあるかを確認する

Sub CheckInputTableDuplicates()
    Dim ws As Worksheet
    Dim inputDataTbl As ListObject
    Dim dataTbl As ListObject
    Dim inputRow As ListRow
    Dim dataRow As ListRow
    Dim col As ListColumn
    Dim cellInput As Range
    Dim cellData As Range
    Dim duplicateFound As Boolean
    
    ' ワークシートとテーブルを指定
    Set ws = ThisWorkbook.Sheets("Sheet1") ' シート名を適切なものに変更
    
    ' 入力テーブルとデータテーブルを指定
    Set inputDataTbl = ws.ListObjects("InputTable") ' 入力テーブル名を適切なものに変更
    Set dataTbl = ws.ListObjects("DataTable") ' データテーブル名を適切なものに変更
    
    ' 各入力行の重複をチェック
    For Each inputRow In inputDataTbl.ListRows
        ' 重複フラグを初期化
        duplicateFound = False
        
        ' 入力テーブルの各列とデータテーブルの対応する列を比較
        For Each col In inputDataTbl.ListColumns
            Set cellInput = inputRow.Range.Cells(col.Index)
            
            ' データテーブルの各行と比較
            For Each dataRow In dataTbl.ListRows
                Set cellData = dataRow.Range.Cells(col.Index)
                
                ' 列が一致しない場合はフラグを設定してループを抜ける
                If cellInput.Value <> cellData.Value Then
                    duplicateFound = True
                    Exit For
                End If
            Next dataRow
            
            ' 一度でも一致しない列があれば次の入力行へ
            If duplicateFound Then Exit For
        Next col
        
        ' 重複が見つかった場合、メッセージを表示
        If Not duplicateFound Then
            MsgBox "重複が見つかりました。入力テーブルの行 " & inputRow.Index & " は既にデータテーブルに存在します。", vbExclamation, "重複チェック"
            Exit Sub ' 一度重複が見つかったら終了
        End If
    Next inputRow
    
    ' 重複が見つからなかった場合のメッセージ
    MsgBox "重複は見つかりませんでした。", vbInformation, "重複チェック"
End Sub