主キーを軸として複数項目を抽出し、統合するには？

質問

Excel2003を使用しています。A列を主キーとしてデータを抽出&統合したいです。（重複レコードは削除）

＜元データ＞
（A列）ID、（B列）時刻、（C列）名称という3列で構成されるデータが3000行あります。

実際のデータ内容としては
　（A列）ID123456、（B列）00:01:00、（C列）りんご 開始、です。

同一IDについては、関連データが必ず2行あります。（データ行の並び順は、ID順というわけではなく、ランダムです）
※「名称」に"開始"という文字が入っているものと、「名称」に"終了"という文字が入っているものの2種類です。
※「時刻」はそれぞれ異なります。
※同一IDの場合、C列の「名称」も（"開始"か"終了"のテキストが入っている事を除けば）同一です。

例1） 関連データ1：（A列）ID123456、（B列）00:01:00、（C列）りんご 開始
　　 関連データ2：（A列）ID123456、（B列）00:05:00、（C列）りんご 終了

＜抽出内容＞
上記のようなデータを、1つのIDにつき1行にまとめ、下記の形式の表を作成したいです。

（A列）ID、（B列）名称、（C列）開始時間、（D列）終了時間、（E列）処理時間（終了時間-開始時間で算出する）

例1）の場合、下記になります。
（A列）ID123456、（B列）りんご、（C列）00:01:00（開始時間）、（D列）00:05:00（終了時間）、（E列）00:04:00（処理時間）

＜希望＞
関数、ピボットテーブル、フィルタオプション、VBA、いずれでも結構ですが、これを元に日々使用する自動ツールを作成するため、汎用性のある簡潔な方法が良いです。
（元データの列構成と抽出後データの列構成は固定ですが、元データ行数は可変します。1万行ぐらいまで増加する可能性あり）

宜しくお願い致します。

回答No.5

keithin

＞ですが、名称（りんご）は重複します。

別に問題ありません。回答した通りの手順で全く問題無く出来ますが、何か？

＃ちなみにマクロだとこんなカンジで。

sub macro1()
　dim LastRow as long

　range("D:I").insert shift:=xlshifttoright
　range("G:I").numberformat = "hh:mm:ss"
　lastrow = range("A65536").end(xlup).row

　with range("D2:D" & lastrow)
　　.formula = "=ROW(D1)"
　　.value = .value
　end with

　range("A:D").sort key1:=range("A1"), order1:=xlascending, key2:=range("B1"), order2:=xlascending, header:=xlyes
　range("E1:I1") = array("ID","商品","開始","終了","処理")

　range("E2").formula = "=A2"
　range("F2").formula = "=LEFT(C2,LEN(C2)-3)
　range("G2").formula = "=B2"
　range("H3").formula = "=B3"
　range("I2").formula = "=H3-G2"
　range("E2:I3").copy range("E2:I" & lastrow )
　range("E2:I" & lastrow).value = range("E2:I" & lastrow).value
　range("E2:I" & lastrow).specialcells(xlcelltypeblanks).delete shift:=xlshiftup
　range("A:D").sort key1:=range("D1"), order1:=xlascending, header:=xlyes

end sub

＃元データの並び順を保全する必要が無ければもっと簡単に。

sub macro1r1()
　dim LastRow as long

　range("E:I").insert shift:=xlshifttoright
　range("G:I").numberformat = "hh:mm:ss"
　lastrow = range("A65536").end(xlup).row

　range("A:C").sort key1:=range("A1"), order1:=xlascending, key2:=range("B1"), order2:=xlascending, header:=xlyes
　range("E1:I1") = array("ID","商品","開始","終了","処理")

　range("E2").formula = "=A2"
　range("F2").formula = "=LEFT(C2,LEN(C2)-3)
　range("G2").formula = "=B2"
　range("H3").formula = "=B3"
　range("I2").formula = "=H3-G2"
　range("E2:I3").copy range("E2:I" & lastrow )
　range("E2:I" & lastrow).specialcells(xlcelltypeblanks).delete shift:=xlshiftup

end sub

お礼

ありがとうございます！