名寄せのためにエクセルの重複データを抽出する方法(2ページ目)

名寄せのための重複抽出サンプル Perl プログラム

#!/usr/bin/perl --

# 名寄せのためにエクセルの重複データを抽出する
# usage: perl select_double_data.pl INPUT_CSV > OUTPUT_CSV

use strict;
use warnings;
use utf8;

my (%conf);

# 環境設定

# 並べ替え対象ファイル
$conf{input_csv} = shift @ARGV; #実行時にコマンドラインから指定したファイル名が @ARGV に格納されている
$conf{csv_enc} = 'cp932'; #文字コード

# 処理
# CSV を読み込み。
my $fh;
open ($fh, "<:encoding($conf{csv_enc})", $conf{input_csv})
	or die "Can't open $conf{input_csv}: $!\nusage: perl select_double_data.pl INPUT_CSV > OUTPUT_CSV\n"
	;

# まずは情報をハッシュに格納。合わせて、必要な前処理を行う。
# 列は左から：通し番号、会社名 (使わない)、姓、名、メールアドレス、電話番号、携帯電話番号
my (%data, %save);
my $c = 0; #ハッシュキーにするカウンター。データに付けられた通し番号は間違いの可能性があるので使わない。
while (<$fh>){
	$c++;
	my $line = $_;
	$line =~ s/\s+$//; #末尾の空白文字を削除
	my @temp = split(/,\s*/, $line); # 0:通し番号、1:会社名 (使わない)、2:姓、3:名、4:メールアドレス、5:電話番号、6:携帯電話番号
	$save{"line_$c"} = $line; #最後に書き出すために保存
	$data{"line_$c"} = {
		num => $temp[0],
		lastname => $temp[2],
		firstname => $temp[3],
		mail => $temp[4],
		tel => $temp[5],
		mobile => $temp[6],
	};
	#電話番号欄と携帯電話番号欄を振り分け。
	if (length $data{"line_$c"}->{tel} && $data{"line_$c"}->{tel} =~ m/^0[789]0/ #電話番号欄に携帯番号が入っている
		and (!length $data{"line_$c"}->{mobile} or $data{"line_$c"}->{mobile} !~ m/^0[789]0/) #携帯番号欄が空か、通常番号
	){
		my $mobile_temp = $data{"line_$c"}->{mobile}; #空または通常番号
		$data{"line_$c"}->{mobile} = $data{"line_$c"}->{tel};
		$data{"line_$c"}->{tel} = $mobile_temp;
	}
	if (length $data{"line_$c"}->{mobile} && $data{"line_$c"}->{mobile} !~ m/^0[789]0/ #携帯電話番号欄に通常番号が入っている
		and (!length $data{"line_$c"}->{tel} or $data{"line_$c"}->{tel} =~ m/^0[789]0/) #電話番号欄が空か、携帯番号
	){
		my $tel_temp = $data{"line_$c"}->{tel}; #空または携帯番号
		$data{"line_$c"}->{tel} = $data{"line_$c"}->{mobile};
		$data{"line_$c"}->{mobile} = $tel_temp;
	}
	#電話番号と携帯電話番号の数字以外を削除
	for (qw(tel mobile)){
		length $data{"line_$c"}->{$_} and $data{"line_$c"}->{$_} =~ s/[^\d]+//g;
	}
	#メールアドレスのドメイン名を保存
	$data{"line_$c"}->{mail} =~ m/\@(.+)$/
		and $data{"line_$c"}->{domain} = $1
		or $data{"line_$c"}->{domain} = '';
	
	#姓と名、それぞれ先頭と末尾の1文字を抽出 (unpackを使い Unicode 文字番号を数値 (10進数) で格納。) 
	for (qw(last first)){
		$data{"line_$c"}->{"${_}name_first"} = unpack('U1', $data{"line_$c"}->{"${_}name"});
		$data{"line_$c"}->{"${_}name_last"} = unpack('U1', reverse($data{"line_$c"}->{"${_}name"}));
	}
}
close ($fh);

#比較開始
#基準項目順に並べ、同じものがあったら重複候補として抽出し、それ以外の比較項目からは外す。
# (大きいファイルの場合は判別対象列だけを取り出してデータファイルは閉じてしまう処理か、データベースの利用が必要。ここでは省略。) 

#重複したペア (またはトリプル以上) を格納しておく配列
my @result;

#1. 電話番号、携帯電話番号、またはメールアドレスのいずれかが一致
for my $std (qw(tel mobile mail)){
	my %index;
	#ハッシュに、基準項目をキーにして該当の"line_(通し番号)"を要素とする配列の参照を格納していく。
	for (grep {length $data{$_}->{$std}} keys %data){ # $_ は "line_(通し番号)"
		push(@{$index{$data{$_}->{$std}}}, $_);
	}
	#2つ以上の配列要素が登録されているものがあれば重複した事を意味する
	for (keys %index){
		if(1 < scalar @{$index{$_}}){
			push(@result, $index{$_});
			for my $l (@{$index{$_}}){
				delete $data{$l}; #この後の判別からは除く。このため、重複が複雑な場合は、数回処理を繰り返す必要があるかもしれない。
			}
		}
	}
}

#2と3. 「下の名前/苗字が一致」かつ以下のいずれか。
#「苗字/下の名前の先頭または末尾が一致」
#「メールアドレスのドメイン名以降が一致」
for my $std (qw(first last)){
	my %index;
	my $checkstd = $std eq 'first'?'last':'first'; #項目が一致した時に、追加でチェックする項目名プレフィックス。名(firstname)なら姓(lastname)、姓なら名
	
	#ハッシュに、基準項目をキーにして該当の"line_(通し番号)"を要素とする配列の参照を格納していく。
	for (grep {length $index{$data{$_}->{"${std}name"}}} keys %data){ # $_ は "line_(通し番号)"
		push(@{$index{$data{$_}->{"${std}name"}}}, $_);
	}
	#2つ以上の配列要素が登録されているものがあれば他の基準をチェック
	for (keys %index){
		if(1 < scalar @{$index{$_}}){
			#配列の参照に格納されている最後の行と、それ以前の行を、比較対照項目に関して比べて行く。
			#最後の行を基準とするのは、一致したときの削除がしやすいため (一致した場合に最後から消して行けば、番号と要素の対応が変わらない)。
			for (my $i=scalar @{$index{$_}}-2; 0<=$i; $i--){
				my $std = scalar @{$index{$_}}-1;
				if ($data{$index{$_}->[$std]}->{"${checkstd}_last"} == $data{$index{$_}->[$i]}->{"${checkstd}_last"} #姓または名の最後の文字が一致
					or $data{$index{$_}->[$std]}->{"${checkstd}_first"} == $data{$index{$_}->[$i]}->{"${checkstd}_first"} #姓または名の最初の文字が一致
					or $data{$index{$_}->[$std]}->{domain} eq $data{$index{$_}->[$i]}->{domain} #メールアドレスドメイン名が一致
				){
					push(@result, [$index{$_}->[$std], $index{$_}->[$i]]);
					delete $data{$index{$_}->[$std]}; #この後の判別からは除く。このため、重複が複雑な場合は、数回処理を繰り返す必要があるかもしれない。
					splice(@{$index{$_}}, -1, 1);
					next;
				}
				#一致するものが無かったときは基準行(=最終行)を削除して続ける
				splice(@{$index{$_}}, -1, 1);
			}
		}
	}
}

# 結果出力
# 書き出し文字コードを準備
binmode STDOUT, "encoding($conf{csv_enc})";

print STDOUT "重複の可能性のある行\n";

for my $arr (@result){
	my @lines = sort map {$_ =~ m/line_(\d+)/ and $1 or $_} @{$arr};
	for my $num (@lines){
		print qq[${num}行目,$save{"line_$num"}\n];
	}
	print "\n";
}

実行コマンド例

perl select_double_data.pl sample.csv > result.csv

プログラムでの処理と人力のバランス

名寄せはある意味で単純な作業ながら、プログラムだけではなかなか処理しきれない部分も多いですね。実務上は、このようにして抽出された重複候補を人力で修正し、必要があれば数回の重複チェックをする想定です。手作業と機械処理をバランスよく使って業務の効率化を目指して下さい。