ExcelTips(For Chief)～兄弟姉妹の抽出～
始めに
Twitterのフォロワーさんから宿題が出ました。
生徒の名簿から兄弟を検索して，レコードの末尾に在籍クラスと名前を表示させたいというものでした。関数だけでなんとかならないかと考えてみたものの，解決策はさっぱり思い浮かばず。
できない事もないのだろうけど，考えていくうちにだんだん大がかりになってきて，あとから見返したらわけがわからんだろうなと思いましてあきらめました。仮に結果が得られたとしても後任の方がメンテナンスができなければそれっきりになるのでまずいなぁと思った次第。
やはりVBAに頼らないとダメなのか…とコードをゴリゴリと書き始めたのですが，それほど行数も多くならず，基本的な手法だけで済んだのではないかと思います。
結果が下の動画です。
わかりやすいように兄弟姉妹がいる生徒のレコードは黄色くなるようにしてあります。
なんとかうまくいったような気がします。
以下説明です。
テーブルを作る
まずデータベースになるテーブルの構造について。
レコードを特定するためにkeyとなる列(フィールド)を作ります。ここでは「生徒ID」です。ここには行(レコード)と特定できるユニークな数値もしくは文字列を納めます。この「生徒ID」は入学してから継続して使い続ける生徒固有のものとします。
次に，分割できるデータは全て分割します。
氏名→姓，名
住所→都道府県，市区町村，町域，番地，建物名
こうすることよってフィルタをかけたりや検索をするときに利便性が上がります。
数字であっても文字列とするべきものがあります。
ここでは，電話番号，郵便番号，番地です。
電話番号は頭文字に「0」を含みますので，数値では基本的に表示できません。
郵便番号も同様で，「-」(ハイフン)も省いた方がいいでしょう。ここでは遺してありますが(^_^;
住所の番地については，Excelのお節介機能で，日付データとなるときがありますので，しっかり文字列にしておく必要があります。
こうやって作成したテーブルをデータベースとして利用していきます。
テーブル作成の前提
また，前提として，
1.このテーブルには途中になんのデータも無い空きレコードない
2.住居を同じくするものは同じ電話番号を持つ
としています。
1.に関しては，上から逐次検索して処理をしていくので，途中に空きレコードがあるとテーブルの最終行を誤ってしまうからです。
2.に関しては，電話番号を住所のキーとします。これにより電話番号にによって住居を特定できます。氏名や住所出ないのは，氏名は同姓同名の可能性があるのでユニークなものとはなり得ず，住所の場合は入力する際の表記揺れの可能性からキーとはなり得ません。その点電話番号であれば，代表電話番号と見なせば一家に１つとなり，かつ数字なので表記揺れも排除できます。
下準備
準備として，レコード末尾に表示するための兄弟名が「年-組 氏名(名)」となるように兄弟表示名を作成しておきます。
ここではセルH3に=TEXTJOIN("-",TRUE,C3:D3)&" "&G3と入力して下に複写しました。(2016以降)
ここではセルH3に=C3&" -"&D3&" "&G3と入力して下に複写しました。(2016未満)
※なお書き直すさいはH4以下に式を入力して複写してください。(H3には名前が定義されているため，セル番地が絶対参照扱いになり，式内のセル番地が自動オフセットしてくれません)
コード解説
プログラムの基本的な考え方は以下の通りです。
まず兄弟がいるかどうかを判別。
そのためには同じ電話番号の数を数えました。
これはワークシート上でCOUNTIF関数を用いてもいいし，今回はVBAで実行しました。
その結果がT列です。
T列が1より大きいレコードがi行にあるとして，そのレコードの電話番号(L列)と等しい電話番号をL列から探します。i行の電話番号と同じ電話番号がj行で見つかったら，j行の兄弟表示名(H列)をi行のの兄弟名(S列)に納めます。二人目以降は，ここに文字を連結させる形でセルに格納します。ただし，j=i(本人)となる場合はこれを行いません。
あとはこの繰り返しです。
仕様
仕様と言うほどのものではありませんが，レコード数の制限はシートの行数の上限です。ただ，パフォーマンスがどうなるかはわかりません。
兄弟の数もセルに入力できる文字数の上限が制限です。
ダウンロード
それではファイルを置いておきます。
※バージョンアップしました(2020/03/18)
・マクロをプライベートからパブリックに変更
・シート上にボタンを配置
・シート上に「処理中」表示
・終了メッセージの変更
・兄弟を改行して表示できるようにした
・兄弟名表示の数式をTEXTJOIN関数ではなく＆演算子に変更(Office2016以前に対応)
コードは標準モジュールに記述してあります。
ざっくり作ったのでエレガントさに欠ける部分はご容赦ください。
注意事項
名前の定義をしています：デーブルの1行目(ワークシートの3行目)は削除しないでください。名前を定義してあり，それをマクロ内で使用しています。
関数の埋め込み時に注意：また上記のせいでワークシートに関数を埋め込むときに注意が必要です。テーブル1行目(シートの3行目)に関数を入力すると，セル番地にセルの名前が自動で入ります。このまま下にコピー＆ペーストをすると絶対参照となりますので期待する結果は得られません。この場合テーブル2行目(シートの4行目)で関数を入力し，それをコピー＆ペーストしてくさい。
フィイールドの追加・削除：フィールドの追加・削除も気をつけてください。名前ではなくセル番地で指定しある所もあります。
コード
Private Sub subSearchBrother()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim intSeitosu As Integer
Dim intLastRow As Integer
With Worksheets("生徒情報")
intLastRow = .Range("生徒数") + 2
intSeitosu = .Range("生徒数")
.Range("T3:U" & intLastRow).ClearContents
For i = 1 To intSeitosu
.Range("兄弟数").Cells(i, 1) = Application.WorksheetFunction.CountIf(.Range("$L$3:$L$" & intLastRow), .Range("電話番号").Cells(i, 1))
Next i
i = 1
Do While .Range("生徒ID").Cells(i, 1) <> ""
If .Range("兄弟数").Cells(i, 1) > 1 Then
j = 1
k = 1
Do While .Range("生徒ID").Cells(j, 1) <> ""
If .Range("電話番号").Cells(j, 1) = .Range("電話番号").Cells(i, 1) Then
If j <> i Then
If k = 1 Then
.Range("兄弟名").Cells(i, 1) = .Range("兄弟表示名").Cells(j, 1)
Else
.Range("兄弟名").Cells(i, 1) = .Range("兄弟名").Cells(i, 1) & "," & .Range("兄弟表示名").Cells(j, 1)
End If
k = k + 1
End If
End If
j = j + 1
Loop
End If
i = i + 1
Loop
End With
MsgBox "Finished"
End Sub
この記事が気に入ったらサポートをしてみませんか？