（Ｅｘｃｅｌ2002）フィルターで抽出→抽出部のみのファイル

いつもお世話になっております。
早速ですが、質問があります。

購入者名と購入品が入ったエクセル表があるとします。

鈴木　けしゴム　１００円
田中　えんぴつ　２００円
山田　じょうぎ　３００円
田中　けしゴム　１００円
鈴木　じょうぎ　３００円
：
：
：
　　　合計(SUBTOTAL9)　１５０００円

ここで鈴木でフィルターをかけると、
鈴木　けしゴム　１００円
鈴木　じょうぎ　３００円
　　　　合計　　４００円

となると思います。

この表示された項目のみを「鈴木ファイル」として保存したいのです。
フィルターにより田中と山田が非表示になっている状態ではなく、
ファイル全体で鈴木(とその合計)しかないデータにしたいのです。

実際は鈴木田中山田ではなく、５０ほどの項目があり、
それぞれを抽出してファイルに分けたいと思っています。

よろしくお願いします。

No.2 ベストアンサー 回答者： telescope 回答日時： 2005/04/13 17:54

ピボットテーブルを使ってみてはいかがでしょう。

表を選択して、「データ」－「ピボットテーブルとピボットグラフ　レポート」を選択するとウィザードが開きます。

同じBook内で作成するなら、既定値のまま「完了」ボタンを押します。

ページのフィールドに「購入者」をドラッグします。
行のフィールドに「購入品」をドラッグします。
データフィールドに「価格」をドラッグします。

ページのフィールドの「購入者」を右クリックして、「ページの表示」をクリックします。

購入者別のシートが出来上がります。
簡単にできすぎて気が抜けるほどです。お試しを。

この回答へのお礼

ご回答いただき、ありがとうございます。

ピボットテーブルを勉強してみます♪
これならほかにも応用できそうですね！

ありがとうございました～♪

お礼日時：2005/04/14 19:33

No.3 回答者： ja7awu 回答日時： 2005/04/13 17:55

次のコードを実行すると、ご希望のブックが、作成されると思います。

現コードで、質問内容の表に合わせた設定になっています。
保存パス名 他、実情に合わせ、変更してください。

如何でしたでしょうか。


Sub ブック個別名分割()
'------- 設定事項 --------------------
Const ShName = "Sheet1" '　　　　<------シート名指定
Const Sort_Col = "A" '　　　　　　　<----------- 整列および分割識別列名を指定
Const Hinmei_Col = "B" '　　　　　<----------- 品名の列名
Const kingaku_Col = "C" '　　　　<----------- 金額の列名
Const Midasi = 1 '　　　　　　　　　　<---------- 見出し部分の行数指定
Const SavePath = "C:\DATA\" '　　<---------- 保存ホルダのパス名
'------------------------------------
Dim NewObj As Workbook
Dim Rowt As Long
Dim Rowe As Long
Dim CName As String
Dim R As Integer
Dim Rw As Long
Dim Cnt As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Worksheets(ShName).Select
Range(Rows(Midasi), Rows(Midasi).End(xlDown)).Select
Selection.Sort Key1:=Range(Sort_Col & Midasi + 1), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlPinYin
Rowt = Midasi + 1
Do Until IsEmpty(Range(Sort_Col & Rowt).Value)
　　CName = Range(Sort_Col & Rowt).Value
　　Rows("1:" & Midasi).Copy
　　Set NewObj = Workbooks.Add
　　NewObj.Sheets(1).Rows(1).Select
　　ActiveSheet.Paste
　　R = 1
　　ThisWorkbook.Activate
　　Do While Range(Sort_Col & Rowt + R).Value = CName
　　　　R = R + 1
　　Loop
　　Rows(Rowt & ":" & Rowt + R - 1).Copy
　　NewObj.Activate
　　Rows(Midasi + 1).Select
　　ActiveSheet.Paste
　　Rw = Range("A65536").End(xlUp).Row
　　Range(Hinmei_Col & Rw + 2).Value = "合計"
　　Range(kingaku_Col & Rw + 2).Formula = "=SUM(" & kingaku_Col & Midasi + 1 & _
　　　　　　":" & kingaku_Col & Rw & ")"
　　Range("A1").Select
　　NewObj.SaveAs SavePath & CName & ".xls"
　　Cnt = Cnt + 1
　　NewObj.Close
　　Rowt = Rowt + R
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Worksheets("Sheet1").Select
Range("A1").Select
Beep
MsgBox Cnt & " 個のブックを作成/更新しました。", , "実行完了"
Set NewObj = Nothing
End Sub

この回答へのお礼

ご回答ありがとうございます。

なんだか目が回りそうな内容ですね！
どうせ使うなら、内容を理解していきたいと思います。
これから勉強していきます。

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

お礼日時：2005/04/14 19:34

No.1 回答者： ThunderV2 回答日時： 2005/04/13 15:39

こんにちは。

自動でやりたいのなら、マクロ組むしかないと思います。
手動で良ければ、フィルタかけた後に、質問の例では、鈴木さんのデータと
合計の部分を範囲選択し、メニューの編集－ジャンプで
セル選択ボタンをクリック後、可視セルを選んでＯＫ押して下さい。
あとは、コピーして、新規ファイルに貼付して、保存すれば、鈴木さんだけのデータになると思います。
これの繰り返しですが、５０ほど項目あると大変ですね。

この回答へのお礼

ご回答ありがとうございます♪

マクロは勉強不足で、
まだまだ手際の悪い作業をしております(^_^;

参考にさせていただきます。
ありがとうございました！

お礼日時：2005/04/14 19:30