エクセルで◯文字以上が一致するセルを検知したい

Question

実現したいこと

とある業務にて
①申込件数は1人1回まで
②申込は紙で行われ、内容をエクセルに転記している
という作業をおこなっております。

いまのやり方は②で記載された氏名と生年月日をconcatenate関数で繋いでおり、繋いだ内容に対してcountif関数で重複チェックを行っています。しかし、②を人間が行っているので、例えば1990年1月1日生まれの田中太郎さんを記載する際に、誤って「田中太朗」と登録してしまっていた場合に、countif文の重複チェックでは弾けず、①の条件を満たさない申込を取り込めないリスクがあります。

この問題を解決するために、例えば「concatenate関数で繋いだ内容と３文字まで一致するセルを検知する」ようなやり方はあるのでしょうか？
ネットで調べてもワイルドカード等の特定の文字列を含むあいまい検索のやり方しか見つかりませんでした。

やり方は関数でもVBAでも何でもOKで、
「こんなやり方があります」と教えてくださるだけで結構です。

ご助言いただけますと大変助かります。
よろしくお願いします。

発生している問題・分からないこと

各セルの入力内容のうち、◯文字まで一致するセルを検知する、といった方法がわからない。

該当のソースコード

特になし

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

やり方が見つけられませんでした。

補足

特になし

Comments

[sk.exe]

> 申込は紙で行われ、内容をエクセルに転記

> 氏名と生年月日

> 例えば1990年1月1日生まれの田中太郎さんを記載する際に、
> 誤って「田中太朗」と登録してしまっていた場合

- 「氏名の誤入力」と同様に「生年月日の誤入力」が発生する可能性も考慮されるべきである。

- 1990年1月1日生まれの田中太「朗」さんという別人が実在する可能性も当然無視されるべきでない。

> 例えば「concatenate関数で繋いだ内容と３文字まで一致するセルを検知する」

[氏名]と[生年月日]を1つの文字列として連結させるのではなく、
[氏名]と[生年月日]のそれぞれで「文字列の類似度を求める計算」を行ない、
いずれか一方または両方の類似度が一定の範囲である組み合わせをリスト出力して
それぞれの候補者が同一人物であるかどうかを人間が判別し、必要に応じて名寄せ作業を
進めるようにするのが妥当ではないかと思います。

文字列の類似度を判定するアルゴリズムにはいくつかありますが、
例えばレーベンシュタイン距離を求める関数を VBA で作成した事例も
ネット上で見つかります。

[onionion]

ご回答ありがとうございます。参考になりました。レーベンシュタイン距離と言う考え方は全く知りませんでした。勉強になりました。

Answer 1

↓これはどうですか？
https://www.bold.ne.jp/engineer-club/vba-find

Comments

[onionion]

ご回答ありがとうございます。ご提示いただいた手法であれば、特定のキーワードを設定してそれが含まれるか否か、という観点での整理となると思いますので、今回のやりたいこととは若干ずれてしまいました。

Answer 2

こういうことですか？？
これの場合だと｢山田太朗｣さんと｢山田次郎｣さんがいた場合､両方拾ってしまいます。

Sub NameCheck()
    Dim buf() As String
    Dim Base() As String
    Dim arr As Variant
    Dim str As String
    Dim R As Long
    Dim i As Long
    Dim n As Long
    
    '対象の名前を変数Baseにバラす
    str = "田中太郎"
    ReDim Base(1 To Len(str))
    For i = 1 To UBound(Base)
        Base(i) = Mid(str, i, 1)
    Next i
    
    For R = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        n = 0
        '1列目に比較対象名前があると想定
        str = Cells(R, 1).Value
        '比較対象の名前もバラす
        ReDim buf(1 To Len(str))
        For i = 1 To UBound(buf)
            For Each arr In Base
                'バラした名前同士を比較し､合致する文字があればnのカウントを増やす
                If arr = Mid(str, i, 1) Then
                    n = n + 1
                End If
            Next arr
        Next i
        
        '3文字以上合致する場合は出力
        If n >= 3 Then
            Debug.Print "対象行：" & R & "の" & Cells(R, 1).Value & "さん"
        End If
    Next R
End Sub

Comments

[onionion]

ご回答ありがとうございます。文字をバラして配列に突っ込んで一致の可否を一文字ずつ確認するという方法ですね。まだ試せてはおりませんが、たしかにコレなら判断できそうですし、汎用性も高そうです。ご丁寧にサンプルコードまで書いていただいてありがとうございます。
発想、コードともに勉強になりました。