『Excel』で文字の一致率を調べたい！

固有名詞などを入力した際には、基本同じになるはずだが…

手入力だと意外に同じにならないことがある…。

微妙に間違うのだ…。

例えば、怪獣名
エレキングを、エイキング…
バルタン星人を、ヴァルタン星人…
ケムラーをゲムラー…
とか…
大抵、間違えないと言った奴が間違えるんだよな…。（笑）

まあ、ちょっと毒が出たけど…

…まあ、それは、置いといて…

１００個ぐらいなら手で治すのも可能だが…

それを超えると手作業は、したくないな…。

例えば、住所は、固有名詞なので誰が入力しても同じはずだが…

結構色々な書き方が可能だ。

東京都千代田区千代田１―１―１
東京都千代田区千代田１丁目１番地１号
東京都千代田区千代田一丁目一番地１号

これらが同じと判断するのは、結構しんどい。

結果、視認による判定とかになる…。

でも、ある程度同じだと分かれば、目途も付きやすいだろう。

って訳で作ってみた！

標準モジュールを作成して以下のマクロをコピペする。

使い方は、セルに
=strMatch(A2,B2)
や
=AddressMatch(A7,B7)
と入力する。

こんな感じ。

で、実際のマクロは、こんな感じ。

'---------------------------------------
' 住所のマッチ
Function addressMatch(a As String, b As String) As Double

    Dim sa As String
    Dim sb As String

    sa = addressConvert(a)
    sb = addressConvert(b)

    addressMatch = strMatch(sa, sb)

End Function

'---------------------------------------
' 文字列置換
Function addressConvert(s As String)

    Dim ss As String

    ss = s

    ss = Replace(ss, "―", "-")

    ss = Replace(ss, "一丁目", "1-")
    ss = Replace(ss, "二丁目", "2-")
    ss = Replace(ss, "三丁目", "3-")
    ss = Replace(ss, "四丁目", "4-")
    ss = Replace(ss, "五丁目", "5-")
    ss = Replace(ss, "六丁目", "6-")
    ss = Replace(ss, "七丁目", "7-")
    ss = Replace(ss, "八丁目", "8-")
    ss = Replace(ss, "九丁目", "9-")
    ss = Replace(ss, "一番地", "1-")
    ss = Replace(ss, "二番地", "2-")
    ss = Replace(ss, "三番地", "3-")
    ss = Replace(ss, "四番地", "4-")
    ss = Replace(ss, "五番地", "5-")
    ss = Replace(ss, "六番地", "6-")
    ss = Replace(ss, "七番地", "7-")
    ss = Replace(ss, "八番地", "8-")
    ss = Replace(ss, "九番地", "9-")

    ss = Replace(ss, "丁目", "-")
    ss = Replace(ss, "番地", "-")
    ss = Replace(ss, "号", "")

    ss = StrConv(ss, vbNarrow)

    addressConvert = ss

End Function

'---------------------------------------
' 文字列のマッチ
Function strMatch(a As String, b As String) As Double

    Dim str_a As String
    Dim str_b As String
    Dim str_a2 As String
    Dim str_b2 As String
    Dim len_a As Integer
    Dim len_b As Integer
    Dim len_c As Integer
    Dim len_m As Integer
    Dim i1 As Integer
    Dim i2 As Integer

    str_a = a
    str_b = b
    len_a = Len(str_a)
    len_b = Len(str_b)

    len_c = len_a
    len_m = len_b

    If len_a > len_b Then
        len_c = len_b
        len_m = len_a
    End If

    If len_c <= 0 Then Exit Function

    For i = 1 To len_c
        str_a2 = Mid(str_a, i, 1)
        str_b2 = Mid(str_b, i, 1)
        If str_a2 <> str_b2 Then
            Exit For
        End If
    Next i
    i1 = i - 1
    strMatch = i1 / len_m

    If strMatch < 1 Then

        Dim str_a_r As String
        Dim str_b_r As String

        str_a_r = StrReverse(str_a)
        str_b_r = StrReverse(str_b)

        For i = 1 To len_c
            If Mid(str_a_r, i, 1) <> Mid(str_b_r, i, 1) Then
                Exit For
            End If
        Next i
        i2 = i - 1
        strMatch = (i1 + i2) / len_m

    End If

End Function

'---------------------------------------

結果を確認してブラッシュアップしたら使えるかと思うが…。

どうだろうか？

ともかく、名称の確認には、役に立ったよ！