Excelでリストを分割して保存
Excelで作成した在庫リストを支店別のファイルに分割したい場合のマクロです。Excel2007で動作を確認しました。
「全体リスト」シート
元となる「全体リスト」です。
この表を別のファイルにコピーし、支店ごとに、必要な行だけを残して、保存します。
・ | A | B | C | D |
1 | 整理番号 | 支店 | 商品 | 数量 |
2 | 10 | 札幌 | A | 500 |
3 | 20 | 札幌 | B | 1,100 |
4 | 30 | 札幌 | C | 1,700 |
5 | 40 | 仙台 | A | 2,300 |
6 | 50 | 仙台 | B | 700 |
7 | 60 | 仙台 | C | 1,300 |
8 | 70 | 福島 | A | 1,900 |
9 | 80 | 福島 | B | 900 |
10 | 90 | 千葉 | C | 1,500 |
11 | 100 | 千葉 | A | 2,100 |
「支店リスト」シート
分割の対象となる「支店リスト」です。ここに挙げられた支店名についてファイルを作成します。
・ | A |
1 | 札幌 |
2 | 仙台 |
3 | 福島 |
4 | 千葉 |
マクロ(VBA)
Sub リスト分割()
Const zentai_row_top = 2 '全体リストのレコードの最初の行
Const zentai_row_bottom = 11 '全体リストのレコードの最後の行
Const zentai_col_siten = 2 '全体リストの支店名がある列
Const siten_col = 1 '支店リストの支店名がある列
siten_row = 1
sitenmei = Sheets("支店リスト").Cells(siten_row, siten_col)
Do
Sheets("全体リスト").Select
Sheets("全体リスト").Copy
For zentai_row = zentai_row_bottom To zentai_row_top Step -1
zentai_sitenmei = Cells(zentai_row, zentai_col_siten)
If zentai_sitenmei <> sitenmei Then
Rows(zentai_row).Delete shift:=xlUp
End If
Next zentai_row
fn = sitenmei & ".xlsx"
ActiveWorkbook.SaveAs Filename:=fn
ActiveWorkbook.Close
siten_row = siten_row + 1
sitenmei = Sheets("支店リスト").Cells(siten_row, siten_col)
Loop While sitenmei <> ""
End Sub
Const zentai_row_top = 2 '全体リストのレコードの最初の行
Const zentai_row_bottom = 11 '全体リストのレコードの最後の行
Const zentai_col_siten = 2 '全体リストの支店名がある列
Const siten_col = 1 '支店リストの支店名がある列
siten_row = 1
sitenmei = Sheets("支店リスト").Cells(siten_row, siten_col)
Do
Sheets("全体リスト").Select
Sheets("全体リスト").Copy
For zentai_row = zentai_row_bottom To zentai_row_top Step -1
zentai_sitenmei = Cells(zentai_row, zentai_col_siten)
If zentai_sitenmei <> sitenmei Then
Rows(zentai_row).Delete shift:=xlUp
End If
Next zentai_row
fn = sitenmei & ".xlsx"
ActiveWorkbook.SaveAs Filename:=fn
ActiveWorkbook.Close
siten_row = siten_row + 1
sitenmei = Sheets("支店リスト").Cells(siten_row, siten_col)
Loop While sitenmei <> ""
End Sub
応用できるように可変部分(行や列)については最初に定数として挙げてあります。
「支店リスト」から支店名を取得します。
「全体リスト」を新しいファイルにシートごとコピーします。
コピー後の「全体リスト」から該当する支店名を探します。
該当しない行については削除して上に詰めます。そのため、下の行から処理を始めるのがポイントです。
不要な行を削除したら、ファイルを保存します。ここでは支店名をファイル名にしています。
次の支店名を取得し、繰り返します。支店名が空になったら終了です。
[ 2010年9月18日 | カテゴリー: Excel | タグ: VBA ]
« Accessのナビゲーションウィンドウでテーブルやクエリを整理する | Excelでシートを隠す方法 »
コメント
-
stabuckyさん
回答ありがとうございます。sitenmei_roman = Sheets(“支店リスト”).Cells(siten_row, siten_roman_col)のところで
「インデックスが有効範囲にありません。」で止まってしまいます…。 -
半角にしていましたが、再度入力してみても同じ結果になります…。
-
stabuckyさん
出来ました!
お時間割いて頂きありがとうございました。
こちらのマクロを参考にさせて頂いています。
下記の①②にしたい場合は、コードをどうすればいいいのでしょうか。
自分なりに色々やってはみたのですが、うまくいきません…。
①全体リストのレコードの最後の行は毎月同じではないのでマクロ実行の度に変更しない。
②「支店リスト」シートのB列にローマ字の支店名を作り、ファイル名をこのローマ字にする。