同姓のときだけ名前も表示する（失敗談）

ある名簿から、名前を取得したい。

1. 名前は、「姓 名」で登録されている（姓と名の間に半角スペース）
2. 取得する名前は、「姓」のみ。
3. 同姓の人がいる場合のみ、「姓 名」を取得する。

姓 名	取得
田中 一郎	⇒ 田中
山田 太郎	⇒ 山田 太郎
山田 花子	⇒ 山田 花子
高橋 次郎	⇒ 高橋

苗字で検索して、名前に同じ漢字がある可能性があることを考えると、単純な検索では不充分だ。そこで、次のように考えた。

1. 名簿を、苗字+半角スペースで二回検索する。
2. 最初の検索結果と、二回目の結果のアドレスが一致する場合、その苗字は一人しかいない。なぜならグルっと回って、同じセルが二回ヒットしているから。
3. 最初の検索結果と、二回目の結果が一致しない場合、同じ苗字の人が複数いることになる。

※姓名に対し名字だけで検索するため、部分一致での検索となる。

Public Function GetDisplayName(my_name As String) As String
    Dim NameTable As ListObject
    Set NameTable = ActiveSheet.ListObjects(1)

    Dim FamilyName As String
        FamilyName = Split(my_name)(0)

    Dim FirstCell As Range
    Dim SecondCell As Range

    Set FirstCell = NameTable.ListColumns("氏名").DataBodyRange.Find(What:=FamilyName & " ", LookAt:=xlPart)
    Set SecondCell = NameTable.ListColumns("氏名").DataBodyRange.Find(What:=FamilyName & " ", After:=FirstCell, LookAt:=xlPart) '
        If FirstCell.Address = SecondCell.Address Then
            GetDisplayName = FamilyName
        Else
            GetDisplayName = my_name
        End If
End Function

よし、さっそく実行だ。・・・あれ、一人しかいない「森さん」が、フルネームで表示されたぞ？冷静に考えてみれば、当たり前。部分一致で検索する以上は、「有森さん」も「森 」の検索対象だったわけで。

というわけで、やり直し。

1. 名字だけで比較して、完全一致したらカウンターをカウントアップ。
2. 自分も含まれるから、カウンターは必ず１以上。カウンターが２以上で、同姓の方あり。

Public Function GetDisplayName(my_name As String) As String
    Dim NameTable As ListObject
    Set NameTable = ActiveSheet.ListObjects(1)

    Dim FamilyName As String
        FamilyName = Split(my_name)(0)

    Dim i As Long
        i = 0
    Dim r As Range
        For Each r In NameTable.ListColumns("氏名").DataBodyRange
            If Split(r)(0) = FamilyName Then
                i = i + 1
            End If
        Next

        If i = 1 Then
            GetDisplayName = FamilyName
        Else
            GetDisplayName = my_name
        End If
End Function

結果、想定どおりの名前を取得することができた。

今日は、「閃いた！と思った妙案は、大抵「穴」がある」というお話でした。

参考まで。