データ重複整理

データ整理していると重複が本当に厄介ですよね。同じ顧客が何度も登録されていたり、似た会社名が違って入力されていたり... 一つ一つ目で探して消すには量が多すぎます。

しかも完全に同じ重複だけあるわけじゃありません。空白が違ったり、大文字小文字だけ違ったり、スペースが少し違う「類似重複」も多いです。こういうのはExcelの基本重複削除機能では見つけられません。

AIを活用すればこんな複雑な重複も簡単に見つけて整理できます。完全重複から類似重複、論理的重複まで全部検出できます。さらに類似度分析までして「80%以上似ていれば重複」という基準も適用できます。

この記事では、AIでデータの重複を見つけて整理する様々な方法を学びます。単純な重複削除から高度なファジーマッチングまで、実務ですぐ使える技法を見ていきましょう。

1. 重複タイプの把握

AIプロンプト

"次の状況別に重複を見つける方法を教えてください:
1. 完全に同一の行
2. 特定列だけ重複している場合
3. 似ているが少し違うデータ (例: 空白、大小文字)
4. 論理的重複 (同じ人の異なるメール)"

AI回答

1. 完全重複: すべての列の値が同一
   → 重複項目削除機能を使用

2. 部分重複: 主要キー値だけ確認
   → COUNTIFSで特定列基準カウント

3. 類似重複: 空白/大小文字の差
   → TRIM、UPPER関数で正規化後比較

4. 論理的重複: ビジネスルール基準
   → 複合条件で判別

2. 基本重複削除

Excel基本機能で重複削除

AIプロンプト:

"A1:E100範囲でメール(C列)基準で
重複を削除するVBAコードを作ってください。
最初の項目は維持して残りは削除してください。"

AI生成VBA:

Sub メール重複削除()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim deleteCount As Long

    Set ws = ThisWorkbook.Sheets("顧客データ")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' 作業前確認
    If MsgBox("重複したメールを持つ行を削除しますか?" & vbCrLf & _
              "(最初の項目は維持されます)", _
              vbYesNo + vbQuestion, "重複削除確認") = vbNo Then
        Exit Sub
    End If

    ' 画面更新停止 (速度向上)
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' 重複削除実行
    ws.Range("A1:E" & lastRow).RemoveDuplicates _
        Columns:=3, _  ' C列(メール)基準
        Header:=xlYes

    ' 削除された行数計算
    deleteCount = lastRow - ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' 画面更新再開
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox deleteCount & "個の重複項目が削除されました。", vbInformation
End Sub

3. 重複表示 (削除せずに)

条件付き書式で重複強調

AIプロンプト:

"重複した値を削除せず赤色で表示してください。
電話番号(D列)基準で2個以上現れる値を探してください。"

AI生成VBA:

Sub 重複表示_条件付き書式()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim rng As Range

    Set ws = ThisWorkbook.Sheets("顧客データ")
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
    Set rng = ws.Range("D2:D" & lastRow)

    ' 既存条件付き書式削除
    rng.FormatConditions.Delete

    ' 重複値強調条件追加
    With rng.FormatConditions.Add( _
        Type:=xlExpression, _
        Formula1:="=COUNTIF($D$2:$D$" & lastRow & ",$D2)>1")

        .Interior.Color = RGB(255, 199, 206)  ' 薄い赤
        .Font.Color = RGB(156, 0, 6)          ' 濃い赤
        .Font.Bold = True
    End With

    MsgBox "重複した電話番号が強調表示されました。", vbInformation
End Sub

重複回数表示

AIプロンプト:

"各行の隣にそのメールが何回現れるか表示してください。"

AI生成数式:

// F列に重複回数表示
=COUNTIF($C$2:$C$1000, C2)

// 重複有無だけ表示
=IF(COUNTIF($C$2:$C$1000, C2)>1, "重複", "")

// 何番目の重複か表示
=IF(COUNTIF($C$2:$C$1000, C2)>1,
   COUNTIF($C$2:C2, C2) & "番目",
   "唯一")

4. 高度な重複処理

複数列組み合わせで重複確認

AIプロンプト:

"名前(A列)と生年月日(B列)が同時に同じ場合だけ
重複と判断して表示してください。"

AI生成数式:

// ヘルパー列(E列)生成: 名前+生年月日結合
=A2&"|"&TEXT(B2,"YYYY-MM-DD")

// F列に重複有無表示
=IF(COUNTIF($E$2:$E$1000, E2)>1, "重複", "")

AI生成VBA (ヘルパー列なしで):

Sub 複合キー重複確認()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim dict As Object
    Dim key As String
    Dim dupCount As Long

    Set ws = ThisWorkbook.Sheets("社員データ")
    Set dict = CreateObject("Scripting.Dictionary")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Application.ScreenUpdating = False

    ' 最初のパス: 重複探し
    For i = 2 To lastRow
        key = ws.Cells(i, 1).Value & "|" & _
              Format(ws.Cells(i, 2).Value, "YYYY-MM-DD")

        If dict.Exists(key) Then
            dict(key) = dict(key) + 1
        Else
            dict.Add key, 1
        End If
    Next i

    ' 2番目のパス: 重複表示
    For i = 2 To lastRow
        key = ws.Cells(i, 1).Value & "|" & _
              Format(ws.Cells(i, 2).Value, "YYYY-MM-DD")

        If dict(key) > 1 Then
            ws.Cells(i, 6).Value = "重複 (" & dict(key) & "件)"
            ws.Rows(i).Interior.Color = RGB(255, 235, 156)
            dupCount = dupCount + 1
        Else
            ws.Cells(i, 6).Value = ""
            ws.Rows(i).Interior.ColorIndex = xlNone
        End If
    Next i

    Application.ScreenUpdating = True

    MsgBox dupCount & "個の重複項目が発見されました。", vbInformation
End Sub

5. 類似重複探し

空白/大小文字無視

AIプロンプト:

"会社名に空白と大小文字の違いだけある重複を探してください。
例: 'Samsung', 'SAMSUNG', ' Samsung 'はすべて同じものとして処理"

AI生成VBA:

Sub 類似重複探し()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim normalizedDict As Object
    Dim originalValue As String
    Dim normalizedValue As String

    Set ws = ThisWorkbook.Sheets("会社リスト")
    Set normalizedDict = CreateObject("Scripting.Dictionary")
    normalizedDict.CompareMode = vbTextCompare ' 大小文字無視
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' E列にヘッダー追加
    ws.Cells(1, 5).Value = "正規化された値"
    ws.Cells(1, 6).Value = "重複状態"

    For i = 2 To lastRow
        originalValue = ws.Cells(i, 1).Value

        ' 正規化: 空白削除 + 大文字変換
        normalizedValue = UCase(Trim(Replace(originalValue, " ", "")))
        ws.Cells(i, 5).Value = normalizedValue

        ' 重複確認
        If normalizedDict.Exists(normalizedValue) Then
            ws.Cells(i, 6).Value = "重複 (原本: " & _
                normalizedDict(normalizedValue) & ")"
            ws.Rows(i).Interior.Color = RGB(255, 199, 206)
        Else
            normalizedDict.Add normalizedValue, originalValue
            ws.Cells(i, 6).Value = "最初"
        End If
    Next i

    MsgBox "類似重複検査が完了しました。", vbInformation
End Sub

ファジーマッチング (類似度ベース)

AIプロンプト:

"レーベンシュタイン距離を使って
80%以上類似した会社名を探してください。"

AI生成VBA:

' レーベンシュタイン距離関数
Function LevenshteinDistance(str1 As String, str2 As String) As Integer
    Dim i As Integer, j As Integer
    Dim cost As Integer
    Dim d() As Integer
    Dim min1 As Integer, min2 As Integer, min3 As Integer

    ReDim d(Len(str1), Len(str2))

    For i = 0 To Len(str1)
        d(i, 0) = i
    Next

    For j = 0 To Len(str2)
        d(0, j) = j
    Next

    For i = 1 To Len(str1)
        For j = 1 To Len(str2)
            If Mid(str1, i, 1) = Mid(str2, j, 1) Then
                cost = 0
            Else
                cost = 1
            End If

            min1 = d(i - 1, j) + 1
            min2 = d(i, j - 1) + 1
            min3 = d(i - 1, j - 1) + cost

            d(i, j) = WorksheetFunction.Min(min1, min2, min3)
        Next
    Next

    LevenshteinDistance = d(Len(str1), Len(str2))
End Function

' 類似度計算 (0~100%)
Function SimilarityPercent(str1 As String, str2 As String) As Double
    Dim maxLen As Integer
    Dim distance As Integer

    maxLen = WorksheetFunction.Max(Len(str1), Len(str2))
    If maxLen = 0 Then
        SimilarityPercent = 100
        Exit Function
    End If

    distance = LevenshteinDistance(str1, str2)
    SimilarityPercent = (1 - distance / maxLen) * 100
End Function

Sub 類似会社名探し()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim similarity As Double
    Dim threshold As Double

    Set ws = ThisWorkbook.Sheets("会社リスト")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    threshold = 80 ' 類似度閾値80%

    ' 結果シート生成
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("類似項目").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    Dim resultWs As Worksheet
    Set resultWs = Sheets.Add(After:=ws)
    resultWs.Name = "類似項目"
    resultWs.Cells(1, 1).Value = "項目1"
    resultWs.Cells(1, 2).Value = "項目2"
    resultWs.Cells(1, 3).Value = "類似度(%)"

    Dim resultRow As Long
    resultRow = 2

    Application.ScreenUpdating = False

    ' すべてのペアを比較
    For i = 2 To lastRow - 1
        For j = i + 1 To lastRow
            similarity = SimilarityPercent( _
                ws.Cells(i, 1).Value, _
                ws.Cells(j, 1).Value)

            If similarity >= threshold Then
                resultWs.Cells(resultRow, 1).Value = ws.Cells(i, 1).Value
                resultWs.Cells(resultRow, 2).Value = ws.Cells(j, 1).Value
                resultWs.Cells(resultRow, 3).Value = Round(similarity, 2)
                resultRow = resultRow + 1
            End If
        Next j

        ' 進捗状況表示
        If i Mod 10 = 0 Then
            Application.StatusBar = "処理中... " & _
                Format(i / lastRow, "0%")
        End If
    Next i

    Application.StatusBar = False
    Application.ScreenUpdating = True

    MsgBox (resultRow - 2) & "個の類似項目が発見されました。", vbInformation
End Sub

まとめ

AIでデータ重複整理:

• ✅ 多様なタイプの重複検出
• ✅ 類似度ベースのファジーマッチング
• ✅ 重複の統合と集約
• ✅ データ品質レポート

次の記事では、IF文とVLOOKUPを自動で作成する方法を学びます。