エクセルで一部分が重複しているデータを抽出したい

質問

頭に様々な肩書の入った氏名と肩書のない同一人物の氏名が混在している一万件ほどのエクセルデータがあります。
このうち同一氏名のものを肩書のあるものに統合したいのですが、どのようにしたら効率よく重複しているデータを抽出できるか教えてください。
尚、条件として同姓同名はいない、肩書はついている場合には前だけで、名字の部分の重複だけ分かれば良いです。

例１　【肩書ありデータ】　代表取締役山田太郎
　　　 【肩書なしデータ】　山田太郎

例2　【肩書ありデータ】　華道家　田中花子
　　　 【肩書なしデータ】　田中花子

回答No.4

kagakusuki · ベストアンサー

例1の「代表取締役山田太郎」の様に、区切りとなる空白等が何もなく、文字が連続している場合もあるものとしますと、パソコンには「どこまでが肩書きであるのか」という事が判断出来ませんから、同姓同名を自動的に判別する事は不可能だと思います。
　例えば、「代表取締役山田太郎」というデータと「俳優森本龍太郎」というデータが存在していた場合、パソコンには、
「太郎」という氏名の人物が、「代表取締役山田」という肩書と「俳優森本龍」という肩書の2つの肩書を持つ同一人物なのか、それとも別人なのかを判断する術はありません。
　もし、「代表取締役山田」という肩書と「俳優森本龍」という肩書という様に、肩書が異なっている場合には、別人と見做すものとしても、例えば「代表取締役山田太郎」の他に、「代表取締役兼社長山田太郎」や「社長山田太郎」、「○×株式会社代表取締役山田太郎」というデータが存在した場合、それらは全て別人と見做されてしまいます。

お礼

ありがとうございます。
おっしゃる通りですね。一致とみなす名前の文字数が名前ごとに違うので、難しいように感じます。

回答No.3

MackyNo1

ケースによって最も効率的な操作が異なりますが、例えば、肩書と名前の間にスペースが入っているなら、以下のような操作が簡単です。

名前列全体をコピーして、リストの右の列に貼り付け、そのまま「データ」「区切り位置」を選択し「次へ」で区切り文字を「スペース」にチェックを入れ「完了」します。肩書のある名前はその右のセルに名前だけ分離していますので、この列を選択して、右クリック「コピー」、元の名前を貼り付けた1つ左側の列の1行目を選択して、右クリック「形式を選択して貼り付け」で「空白セルを無視する」のチェックを入れてOKします。
これで肩書のない名前だけに統一されていますので、この列を基準に並べ替えを行えば、同じデータがまとめて表示されますので、肩書がある（右の列に名前のある行）セルの左の元の名前欄の肩書が書かれているセルを、前後にオートフィルコピーします（作業するときは名前の行と区切り位置で生成した名前の行以外は非表示にして作業するとわかりよいと思います）。

肩書と名前の間にスペースがないような場合は、名前の長さが7文字以上などの検索条件を使うなど、やや煩雑な手段を使うことになりますが、ひとまず上記の回答でうまく処理できないか調べてみてください。

＃Officeソフトはバージョンによって使用できる機能や操作方法が大きく異なりますので、質問の際には必ずバージョンを明記するようにしましょう。

お礼

ありがとうございます。
Excelのバージョンは2010です。

回答No.2

zoe_falken

オートフィルタを使用すればよいと思います

名前が入力されているセルの一つ上を選択した状態で

ツールバー　→　データ　→　フィルタ　→　オートフィルタ　の順に選択します

すると、選択していたセルの左側に下向きの矢印が表示されます

これをクリックして表示されるウインドウに抽出条件を入力します

すると、その条件にそった入力内容のみを表示します

お礼

ありがとうございます。

回答No.1

tom04

こんにちは！
VBAでの一例です。

Sheet1のA2セル以降にデータがあるとします。
画面左下にあるSheet1のSheet見出し上で右クリック　→　コードの表示　→　VBE画面が出ますので
下のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i As Long
Columns(2).Insert
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Columns(1), "*" & Cells(i, 1) & "*") > 1 Then
Cells(i, 2) = 1
End If
Next i
For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If Cells(i, 2) = 1 Then
Rows(i).Delete
End If
Next i
Columns(2).Delete
End Sub 'この行まで

※　尚、一旦マクロを実行すると元に戻せませんので別Sheetにデータをコピーしてマクロを試してみてください。

他に良い方法があればごめんなさいね。m(_ _)m

お礼

丁寧なご説明ありがとうございます。