EXCEL VBA 類似データを検索・文字列の類似性を評価・あいまいなデータを検索（レーベンシュタイン距離）

●はじめに

今回説明するのは、類似データを検索するときに便利な「レーベンシュタイン距離」を利用したデータ検索方法を説明いたします。レーベンシュタイン距離（Levenshtein distance）は、2つの文字列の類似性を測るための距離指標で、編集距離（Edit Distance）の一種です。この距離は、一方の文字列をもう一方の文字列に変換するために必要な最小限の編集操作数を示します。編集操作には、次の3つのタイプがあります。

編集操作	内容（説明）
挿入	文字列に1文字を挿入します。
削除	文字列から1文字を削除します。
置換	文字列の1文字を別の文字に置き換えます。

●レーベンシュタイン距離は、これらの操作のコストをすべて1として計算します。

【例１】：例として、文字列 “plane” と “plans” のレーベンシュタイン距離を計算してみましょう。

“plane” から “plans” に置換（’e’ を ‘s’ に置き換え）：距離 = 1

この例では、レーベンシュタイン距離は1です。距離＝数値が小さい程、文字列が類似している事になります。

【例2】:例として、文字列 “kitten” と “sitting” のレーベンシュタイン距離を計算してみましょう。

①　“kitten” から “sitten“ に置換（’k’ を ‘s’ に置き換え）：距離 = 1
②　“sitten“ から “sittin“ に置換（’e’ を ‘i’ に置き換え）：距離 = 2
③　“sittin“ から “sitting“に挿入（’g’ を末尾に挿入）　：距離 = 3

この例では、レーベンシュタイン距離は3です。

【例3】:例として、文字列 “machine” と “mechanic” のレーベンシュタイン距離を計算してみましょう。

①　”machine” から “mechine” に置換（’a’ を ‘e’ に置き換え）：距離 = 1
② “mechine” から “mechane” に置換（’i’ を ‘a’ に置き換え）：距離 = 2
③ “mechane” から “mechani” に置換（’e’ を ‘i’ に置き換え）：距離 = 3
④　”mechani” から “mechanic” に挿入（’c’ を末尾に挿入）：距離 = 4

この例では、レーベンシュタイン距離は4です。

●レーベンシュタイン距離を業務で使用する場合は、以下のような業務で使用する事が考えられます。

①顧客データの重複チェック: 顧客データベース内で、名前や住所が類似している顧客を特定し、重複登録や入力ミスがないか確認する際にレーベンシュタイン距離を利用できます。
②商品名のスペルチェック: 商品データベースで、誤って入力された商品名や類似した商品名を検出し、修正するためにレーベンシュタイン距離を利用できます。
③エラーメッセージの分析: システムから出力されるエラーメッセージのログを分析し、類似したエラーをまとめて対応策を検討する際に、レーベンシュタイン距離を利用できます。
④社内文書の類似性検出: 企業内で作成された文書や報告書などの類似性を検出し、重複や似たような内容の文書がないか確認する際にレーベンシュタイン距離を利用できます。
⑤顧客対応履歴の分析: 顧客サポートの履歴を分析し、類似した問い合わせや対応パターンを特定するためにレーベンシュタイン距離を利用できます。これにより、より効率的な対応方法やFAQの作成に役立てることができます。

・これらの具体例は、レーベンシュタイン距離を使ったVBAが業務でどのように役立つかを示しています。これらのシナリオでは、類似したデータやテキストを特定し、効率的に分析や整理を行うことができます。レーベンシュタイン距離は、特に大量のデータが存在する場面で、類似性を判定する手法として有効です。これにより、データのクレンジングや検証を行い、業務の質を向上させることができます。

●【EXCEL VBA あいまい検索については、下記を参照して下さい】

EXCEL VBA レーベンシュタイン距離を使った類似データを検索（会社名を検索）

●プログラム説明　(サンプル①)

下記のサンプルプログラムは、上記の説明の通りにレーベンシュタイン距離を使用して、似ている文字列を検索します。具体的には、指定した会社名と他の会社名リストとの間のレーベンシュタイン距離を計算し、指定されたしきい値以下の会社名を抽出して表示するものです。指定したしきい値により抽出する範囲を調整する事ができます。

【プログラムの流れ】

①　会社名リストの範囲を取得（A列）
②　検索する会社名を取得（セル：C2）
③　レーベンシュタイン距離のしきい値を取得（セル：C４）
④　会社名リストと検索する会社名との間のレーベンシュタイン距離を計算
⑤　しきい値以下の距離の会社名を配列に格納
⑥　似ている会社名を出力（D列）

【プログラム実行条件・注意事項】

・セル範囲は、使用するワークシートのデータに応じて適切に変更する必要があります。
・大文字・小文字の区別をしたくない場合は、LevenshteinDistance関数内でMid関数を使用する前に、UCaseまたはLCase関数で文字列を変換してください。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　LevenshteinDistance01（サンプルプログラム）

'
Option Explicit

' 似ている会社名を抽出するサブルーチン
Sub ExtractSimilarCompanyNames()
    ' データが記録されたセルの範囲を取得
    Dim companyNamesRange As Range
    Dim LastRow As Long
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row  '会社名の一覧（A列最終行を取得する）
    
    Set companyNamesRange = Range("A1:A" & LastRow + 1) ' 適切な範囲に変更してください
    
   '前回結果をクリアー
    Range("D2:D15").ClearContents
    
    ' 検索する会社名
    Dim searchCompanyName As String
    searchCompanyName = Range("C2") ' 適切な会社名に変更してください
    
    ' 似ている会社名を格納するための配列を初期化
    Dim similarCompanyNames() As String
    ReDim similarCompanyNames(1 To companyNamesRange.Rows.Count)
    
    ' レーベンシュタイン距離のしきい値
    Dim threshold As Long
    threshold = Range("C4") ' しきい値に変更してください
    
    '
' セルの値を比較し、似ている会社名を抽出
    Dim i As Long, j As Long
    For i = 1 To companyNamesRange.Rows.Count
        If companyNamesRange.Cells(i, 1).Value <> "" Then
            Dim distance As Long
            distance = LevenshteinDistance(searchCompanyName, companyNamesRange.Cells(i, 1).Value)
            If distance <= threshold Then
                ' しきい値以下の場合、似ている会社名として配列に格納
                j = j + 1
                similarCompanyNames(j) = companyNamesRange.Cells(i, 1).Value
            End If
        End If
    Next i
    
    ' 似ている会社名を出力
    If j > 0 Then
        Dim outputRange As Range
        Set outputRange = Range("D2:D" & j + 1) ' 適切なセル範囲に変更してください
        outputRange.Value = WorksheetFunction.Transpose(similarCompanyNames)
    Else
        MsgBox "似ている会社名は見つかりませんでした。"
    End If
    
    
End Sub
'
' レーベンシュタイン距離を計算する関数
Function LevenshteinDistance(s As String, t As String) As Long
    Dim i As Long, j As Long, cost As Long
    Dim d() As Long
    
    ' 文字列の長さを取得
    Dim s_len As Long: s_len = Len(s)
    Dim t_len As Long: t_len = Len(t)
    
    ' 文字列が空の場合、レーベンシュタイン距離は文字列の長さとなる
    If s_len = 0 Then
        LevenshteinDistance = t_len
        Exit Function
    End If
    
    If t_len = 0 Then
        LevenshteinDistance = s_len
        Exit Function
    End If
    
    ' 初期化
    ReDim d(0 To s_len, 0 To t_len)
    
    For i = 0 To s_len
        d(i, 0) = i
    Next i
    
    For j = 0 To t_len
        d(0, j) = j
    Next j
    
    ' 文字列を比較して、レーベンシュタイン距離を計算
    For i = 1 To s_len
        For j = 1 To t_len
            If Mid(s, i, 1) = Mid(t, j, 1) Then
                cost = 0
            Else
                cost = 1
            End If
            
            d(i, j) = Application.WorksheetFunction.Min(d(i - 1, j) + 1, _
                d(i, j - 1) + 1, d(i - 1, j - 1) + cost)
        Next j
    Next i
    
    LevenshteinDistance = d(s_len, t_len)
End Function
'
'

●実行前～実行後　※プログラム実行後、指定した会社名「Google」としきい値を元に、類似した会社名がD列「似ている会社名」が抽出されました。しきい値を変更する事で抽出される結果が変化します。抽出する結果に併せてしきい値を変化させて下さい。

EXCEL VBA レーベンシュタイン距離を使った類似データを検索（本のタイトルと保管位置を検索）

●プログラム説明　(サンプル②)

下記のサンプルプログラムは、サンプル①の一部を応用したプログラムになります。上記の説明の通りにレーベンシュタイン距離を使用して、似ている文字列を検索します。具体的には、指定した本のタイトルと他の本のタイトルリストとの間のレーベンシュタイン距離を計算し、指定されたしきい値以下の本のタイトルを抽出して類似したタイトルと本が保管している保管場所を表示するものです。指定したしきい値により抽出する範囲を調整する事ができます。

【プログラムの流れ】
①　ワークシート上の指定された範囲のデータ（本のタイトルと棚の番号）を取得します。
②　検索対象の本のタイトル（セルD2）とレーベンシュタイン距離のしきい値（セルD4）を取得します。
③　各本のタイトルに対して、検索対象の本のタイトルとのレーベンシュタイン距離を計算します。
④　計算されたレーベンシュタイン距離がしきい値以下であれば、その本のタイトルを類似したタイトルとして抽出します。
⑤　類似したタイトル（E列）と対応する棚の番号（F列）を、セルE2およびF2から始まる範囲に出力します。

【プログラム実行条件・注意事項】
①　本のタイトルが入力されていない行がある場合、その行は処理されません。データを入力する際は、空白行がないことを確認してください。
②　しきい値を適切に設定することが重要です。しきい値が高すぎると、無関係なタイトルが抽出される可能性があります。逆に、しきい値が低すぎると、類似するタイトルが抽出されない可能性があります。
③　検索対象の本のタイトル（セルD2）が空の場合、結果は出力されません。必ず検索対象の本のタイトルを入力してください。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　LevenshteinDistance02（サンプルプログラム）

'
'
Option Explicit

' 類似する本のタイトルを抽出するサブルーチン
Sub ExtractSimilarBookTitles()
    ' データが記録されたセルの範囲を取得
    Dim bookTitlesRange As Range
    Dim LastRow As Long

    LastRow = Cells(Rows.Count, "A").End(xlUp).Row  '本のタイトルの一覧（A列最終行を取得する）

    Set bookTitlesRange = Range("A2:A" & LastRow)

    ' 前回結果をクリア
    Range("E2:F" & Rows.Count).ClearContents

    ' 検索する本のタイトル
    Dim searchBookTitle As String
    searchBookTitle = Range("D2")

    ' 似ている本のタイトルと棚番号を格納するための配列を初期化
    Dim similarBookTitles() As String
    Dim shelfNumbers() As String
    ReDim similarBookTitles(1 To bookTitlesRange.Rows.Count)
    ReDim shelfNumbers(1 To bookTitlesRange.Rows.Count)

    ' レーベンシュタイン距離のしきい値
    Dim threshold As Long
    threshold = Range("D4")

    ' セルの値を比較し、似ている本のタイトルを抽出
    Dim i As Long, j As Long
    For i = 1 To bookTitlesRange.Rows.Count
        If bookTitlesRange.Cells(i, 1).Value <> "" Then
            Dim distance As Long
            distance = LevenshteinDistance(searchBookTitle, bookTitlesRange.Cells(i, 1).Value)
            If distance <= threshold Then
                ' しきい値以下の場合、似ている本のタイトルとして配列に格納
                j = j + 1
                similarBookTitles(j) = bookTitlesRange.Cells(i, 1).Value
                shelfNumbers(j) = Cells(i + 1, 2).Value
            End If
        End If
    Next i

    ' 似ている本のタイトルと棚番号を出力
    If j > 0 Then
        Dim outputRange As Range
        Set outputRange = Range("E2:E" & j + 1)
        outputRange.Value = WorksheetFunction.Transpose(similarBookTitles)

        Set outputRange = Range("F2:F" & j + 1)
        outputRange.Value = WorksheetFunction.Transpose(shelfNumbers)
    Else
        MsgBox "類似する本のタイトルは見つかりませんでした。"
    End If

End Sub

' レーベンシュタイン距離を計算する関数
Function LevenshteinDistance(s As String, t As String) As Long
    Dim i As Long, j As Long, cost As Long
    Dim d() As Long

    ' 文字列の長さを取得
    Dim s_len As Long: s_len = Len(s)
    Dim t_len As Long: t_len = Len(t)

    ' 文字列が空の場合、レーベンシュタイン距離は文字列の長さとなる
    If s_len = 0 Then
        LevenshteinDistance = t_len
        Exit Function
    End If
    
    If t_len = 0 Then
        LevenshteinDistance = s_len
        Exit Function
    End If

    ' 初期化
    ReDim d(0 To s_len, 0 To t_len)
    
    For i = 0 To s_len
        d(i, 0) = i
    Next i
    
    For j = 0 To t_len
        d(0, j) = j
    Next j
    
    ' 文字列を比較して、レーベンシュタイン距離を計算
    For i = 1 To s_len
        For j = 1 To t_len
            If Mid(s, i, 1) = Mid(t, j, 1) Then
                cost = 0
            Else
                cost = 1
            End If
        
            d(i, j) = Application.WorksheetFunction.Min(d(i - 1, j) + 1, _
                d(i, j - 1) + 1, d(i - 1, j - 1) + cost)
        Next j
    Next i
    
    LevenshteinDistance = d(s_len, t_len)

End Function
'
'

●実行前～実行後　※プログラム実行後、検索する本のタイトルとA列にある本のタイトルのレーベンシュタイン距離を計算し、その距離がしきい値以下の場合、似たタイトルの本のタイトルと保管場所を配列に格納します。最後に、E列に「似た本のタイトル」を、F列にその本の「保管場所」をF列出力します。
（画面クリックして拡大）

最後まで、ご覧いただきまして誠に有難うございました。
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。

AKIRA