- ベストアンサー
(Excel2002)フィルターで抽出→抽出部のみのファイル
いつもお世話になっております。 早速ですが、質問があります。 購入者名と購入品が入ったエクセル表があるとします。 鈴木 けしゴム 100円 田中 えんぴつ 200円 山田 じょうぎ 300円 田中 けしゴム 100円 鈴木 じょうぎ 300円 : : : 合計(SUBTOTAL9) 15000円 ここで鈴木でフィルターをかけると、 鈴木 けしゴム 100円 鈴木 じょうぎ 300円 合計 400円 となると思います。 この表示された項目のみを「鈴木ファイル」として保存したいのです。 フィルターにより田中と山田が非表示になっている状態ではなく、 ファイル全体で鈴木(とその合計)しかないデータにしたいのです。 実際は鈴木田中山田ではなく、50ほどの項目があり、 それぞれを抽出してファイルに分けたいと思っています。 よろしくお願いします。
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
ピボットテーブルを使ってみてはいかがでしょう。 表を選択して、「データ」-「ピボットテーブルとピボットグラフ レポート」を選択するとウィザードが開きます。 同じBook内で作成するなら、既定値のまま「完了」ボタンを押します。 ページのフィールドに「購入者」をドラッグします。 行のフィールドに「購入品」をドラッグします。 データフィールドに「価格」をドラッグします。 ページのフィールドの「購入者」を右クリックして、「ページの表示」をクリックします。 購入者別のシートが出来上がります。 簡単にできすぎて気が抜けるほどです。お試しを。
その他の回答 (2)
- ja7awu
- ベストアンサー率62% (292/464)
次のコードを実行すると、ご希望のブックが、作成されると思います。 現コードで、質問内容の表に合わせた設定になっています。 保存パス名 他、実情に合わせ、変更してください。 如何でしたでしょうか。 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
お礼
ご回答ありがとうございます。 なんだか目が回りそうな内容ですね! どうせ使うなら、内容を理解していきたいと思います。 これから勉強していきます。 ありがとうございました!
- ThunderV2
- ベストアンサー率58% (119/205)
こんにちは。 自動でやりたいのなら、マクロ組むしかないと思います。 手動で良ければ、フィルタかけた後に、質問の例では、鈴木さんのデータと 合計の部分を範囲選択し、メニューの編集-ジャンプで セル選択ボタンをクリック後、可視セルを選んでOK押して下さい。 あとは、コピーして、新規ファイルに貼付して、保存すれば、鈴木さんだけのデータになると思います。 これの繰り返しですが、50ほど項目あると大変ですね。
お礼
ご回答ありがとうございます♪ マクロは勉強不足で、 まだまだ手際の悪い作業をしております(^_^; 参考にさせていただきます。 ありがとうございました!
お礼
ご回答いただき、ありがとうございます。 ピボットテーブルを勉強してみます♪ これならほかにも応用できそうですね! ありがとうございました~♪