エクセルで複数のファイルを統合したい

質問

エクセルについて質問です。
下記のような2つのファイルがあるとします。
１）異動情報
社員番号 社員氏名 日付 部署
33 Aさん 2005/9/1 人事部
Aさん 2006/10/1 総務部
Aさん 2006/12/1 営業部
44 Bさん 2006/9/1 広報部
Bさん 2006/10/1 経理部
55 Ｃさん 2006/4/1 販売部

２）給与情報社員番号 社員氏名 支給年月 本給 各種手当 残業代・・・
33 Aさん 2006年4月 100000 50000 20000
Aさん 2006年5月 100000 50000 15000
Aさん 2006年6月 100000 50000 20000
Aさん 2006年7月 100000 50000 15000
Aさん 2006年8月 100000 50000 20000
Aさん 2006年9月 120000 50000 15000
44 Bさん 2006年4月 110000 60000 8000
Bさん 2006年5月 110000 60000 8000
Bさん 2006年6月 110000 60000 8000
Bさん 2006年7月 110000 60000 8000
Bさん 2006年8月 110000 60000 8000
Bさん 2006年9月 110000 60000 8000
55 Ｃさん 2006年8月 90000 40000 20000
Ｃさん 2006年9月 90000 40000 20000

この二つの表を合わせて

社員番号33　社員氏名　Ａさん
異動情報・・・　　　　　　　給与情報・・・
＊＊＊＊　　　　　　　　　＋＋＋＋＋
＊＊＊＊　　　　　　　　　＋＋＋＋＋

社員番号44　社員氏名　Ｂさん
異動情報・・・　　　　　　　給与情報・・・
＊＊＊＊　　　　　　　　　＋＋＋＋＋
＊＊＊＊　　　　　　　　　＋＋＋＋＋

社員番号55　社員氏名　Ｃさん
異動情報・・・　　　　　　　給与情報・・・
＊＊＊＊　　　　　　　　　＋＋＋＋＋
＊＊＊＊　　　　　　　　　＋＋＋＋＋

のように個人ごとの台帳のようなものを作りたいと思います。
vlookupのひとつの行だけでなく、複数行を対象にしたバージョンのようなイメージです。

こんなことできますでしょうか。
教えていただけたら幸いです。

よろしくお願いします。

回答No.1

toshi_2000 · ベストアンサー

マクロを使用すれば可能です。
既存の２つのファイルと新規ファイルを開けた状態で次のマクロを実行します。
Sub TEST()
MYBOOK = ActiveWorkbook.Name
Workbooks("異動情報.XLS").Activate
異動行 = 2
給与行 = 2
出力行 = 1

Do While Cells(異動行, 2) <> ""
社員番号 = Cells(異動行, 1)
社員名 = Cells(異動行, 2)

Workbooks(MYBOOK).Activate
Cells(出力行, 1) = "社員番号"
Cells(出力行, 2) = 社員番号
Cells(出力行, 3) = "社員名"
Cells(出力行, 4) = 社員名
出力行 = 出力行 + 1
出力行2 = 出力行
Cells(出力行, 1) = "異動情報"
出力行 = 出力行 + 1
Do While Workbooks("異動情報.XLS").Worksheets("SHEET1").Cells(異動行, 2) = 社員名
Cells(出力行, 1) = Workbooks("異動情報.XLS").Worksheets("SHEET1").Cells(異動行, 3)
Cells(出力行, 1).NumberFormatLocal = "yyyy/m/d"
Cells(出力行, 2) = Workbooks("異動情報.XLS").Worksheets("SHEET1").Cells(異動行, 4)
出力行 = 出力行 + 1
異動行 = 異動行 + 1
Loop

Cells(出力行2, 3) = "給与情報"
出力行2 = 出力行2 + 1
Do While Workbooks("給与情報.XLS").Worksheets("SHEET1").Cells(給与行, 2) = 社員名
Cells(出力行2, 3) = Workbooks("給与情報.XLS").Worksheets("SHEET1").Cells(給与行, 3)
Cells(出力行2, 3).NumberFormatLocal = "yyyy年m月"
Cells(出力行2, 4) = Workbooks("給与情報.XLS").Worksheets("SHEET1").Cells(給与行, 4)
Cells(出力行2, 5) = Workbooks("給与情報.XLS").Worksheets("SHEET1").Cells(給与行, 5)
Cells(出力行2, 6) = Workbooks("給与情報.XLS").Worksheets("SHEET1").Cells(給与行, 6)
出力行2 = 出力行2 + 1
給与行 = 給与行 + 1
Loop

If 出力行 < 出力行2 Then
出力行 = 出力行2
End If

出力行 = 出力行 + 1
Workbooks("異動情報.XLS").Activate
Loop
End Sub

お礼

感動しました！

すごいですね！

ぜひ利用させていただきます。

ありがとうございました。