EXCELの関数またはマクロ教えてください。

質問

こんばんは。
よろしくお願いいたします。

EXCEL2000です。

(1)こんな縦に重複した名前の表を、
名前　コード　内訳名　金額
鈴木　　1　　　飴　　 \100
鈴木　　2 　　　ガム　 \150
鈴木　　4 　　　米　　 \1,000
鈴木　　6 　　　食器　 \500
佐藤　　1 　　　飴　　 \100
佐藤　　2 　　　ガム　 \200
佐藤　　3 　　　パン　 \300
田中　　1 　　　米　　 \1,300
田中　　2 　　　ガム　 \200
田中　　4 　　　米　　 \1,300
田中　　6 　　　食器　 \600

(2)横に一人一レコードにまとめたいのです。
　列の項目が内訳名になり増ますよね。
名前　　飴　　　　ガム　　パン　　　 米　　　　食器
鈴木　　\100　　　\150　　\1,000　　\500
佐藤　　\100　　　\200　　\300
田中　　\1,300　　\200　　　　　　　\1,300　　 \600

(3)欲を言えば、飴とガムは合計したいです。これが最終形態です。
名前　お菓子　パン 　　米　 食器
鈴木　\250　　\1,000　\500
佐藤　\300　　\300
田中　\1,500　\1,300　　　　\600

せめて(1)から(2)にする方法で何かよい関数などないでしょうか。
でなくても、「はじめからこんなマクロ・VBAでこんなのできるよ。」
なんてのがあれば、モジュールで教えてください。
本当に本当によろしくお願いいたします。
このデータは後、３００くらいあります。
私のレベルは、MOS上級取得なので、多少理解力はあるかと思います。
というか、必死で頑張りますのでお願いします。m(__)m

回答No.6

Wendy02

#5 です。
二つのミスを見つけましたので、飴とガムを集計するマクロの修正します。

Sub 集計2()
Dim Rng As Range, c As Range
'シートを選択（念のため）
Worksheets("Sheet2").Select
Set Rng = Range("A1", Range("A65536").End(xlUp)).Offset(, 1)
Application.ScreenUpdating = False
'重複実行防止
If Rng.Cells(1, 1).Value = "お菓子" Then Exit Sub
　Rng.Cells(1, 1).Value = "お菓子"
For Each c In Rng
　　If VarType(c) <> vbString Then
　　c.Value = c.Value + c.Offset(, 1).Value
　　End If
Next c
Rng.Offset(, 1).EntireColumn.Delete
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

お礼

重ね重ね大変恐縮です。
勉強させていただいております。