名寄せ関数を作ってみた

背景

個人情報の付き合わせ確認効率化欲求の増大

• 私が今いるところでは、２つの異なる不完全な個人情報データベースを参照しながら、個人情報をまとめる作業が存在する。
• しかし、異なる個人情報データベース間では、「名前だけが頼り」となりがちなのだけど、その名前も「さいとう」さんの「さい」の字の難しさや、旧姓使用の有無などにより、あてにならない場合が存在する。
• そんな時にvlookup関数の部分一致検索を藁にも縋る思いで使ってみるものの、頼りない結果しか帰って来ず、イライラすることが多かった。
• 機械学習を使いこなせる人であれば、その他の情報から一番近似値の高い名前を見つけてくる、というコードを書けるのだろうけど、文系vbaユーザとしてはそこまでハードルの高いものはまだ書けないので、他の情報を元に尤もらしい人名（人名でなくてもいいのだけど）を引っ掛けるvbaのコードを作ったので、備忘録がてら書き残したい。

コード

• vbaです。へっぽこですいません。

sim_distance.xlsm

Function sim_distance(sname As String, mycolumn As Long, a As Variant, arange As Range, b As Variant, brange As Range, c As Variant, crange As Range)
    Dim aarange As Range, bbrange As Range, ccrange As Range
    Dim sim_distance2a As Long, sim_distance2b As Long, sim_distance2c As Long, sim_distance2r As Long

    For Each aarange In arange
        If aarange.Value = a Then
            sim_distance2a = aarange.Row
            Exit For
        End If
    Next aarange
    
    For Each bbrange In brange
        If bbrange.Value = b Then
            sim_distance2b = bbrange.Row
            Exit For
        End If
    Next bbrange
    
    For Each ccrange In crange
        If ccrange.Value = c Then
            sim_distance2c = ccrange.Row
            Exit For
        End If
    Next ccrange

    Dim sim As Variant
    sim = Array(sim_distance2a, sim_distance2b, sim_distance2c)
    sim_distance2r = Application.WorksheetFunction.Max(sim)
    If sim_distance2r = 0 Then
        sim_distance2 = "引数を変更するか追加した新たな関数を作って再度試してください"
    Else
        sim_distance2 = Worksheets(sname).Cells(CLng(sim_distance2r), mycolumn).Value
    End If
End Function

関数の意味

• 引数1「sname」：引っ張ってきたいシート名
• 引数2「mycolumn」：引っ張ってきたい列番号
• 引数3「a」：引っ張るためのヒントその１
• 引数4「arange」：引っ張るためのヒント１を探す範囲
• 引数5「b」：引っ張るためのヒントその２
• 引数6「brange」：引っ張るためのヒント２を探す範囲
• 引数7「c」：引っ張るためのヒントその３
• 引数8「crange」：引っ張るためのヒント３を探す範囲
• 引数を増やすことはできますが、ひとまず３つぐらい参照していれば、それなりの精度が保てるかなと思い、３つにしています。