Excelで作成した在庫リストを支店別のファイルに分割したい場合のマクロです。Excel2007で動作を確認しました。
「全体リスト」シート
元となる「全体リスト」です。
この表を別のファイルにコピーし、支店ごとに、必要な行だけを残して、保存します。
| ・ | A | B | C | D |
| 1 | 整理番号 | 支店 | 商品 | 数量 |
| 2 | 10 | 札幌 | Ａ | 500 |
| 3 | 20 | 札幌 | Ｂ | 1,100 |
| 4 | 30 | 札幌 | Ｃ | 1,700 |
| 5 | 40 | 仙台 | Ａ | 2,300 |
| 6 | 50 | 仙台 | Ｂ | 700 |
| 7 | 60 | 仙台 | Ｃ | 1,300 |
| 8 | 70 | 福島 | Ａ | 1,900 |
| 9 | 80 | 福島 | Ｂ | 900 |
| 10 | 90 | 千葉 | Ｃ | 1,500 |
| 11 | 100 | 千葉 | Ａ | 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
応用できるように可変部分(行や列)については最初に定数として挙げてあります。
「支店リスト」から支店名を取得します。
「全体リスト」を新しいファイルにシートごとコピーします。
コピー後の「全体リスト」から該当する支店名を探します。
該当しない行については削除して上に詰めます。そのため、下の行から処理を始めるのがポイントです。
不要な行を削除したら、ファイルを保存します。ここでは支店名をファイル名にしています。
次の支店名を取得し、繰り返します。支店名が空になったら終了です。
コメント
こちらのマクロを参考にさせて頂いています。
下記の①②にしたい場合は、コードをどうすればいいいのでしょうか。
自分なりに色々やってはみたのですが、うまくいきません…。
①全体リストのレコードの最後の行は毎月同じではないのでマクロ実行の度に変更しない。
②「支店リスト」シートのB列にローマ字の支店名を作り、ファイル名をこのローマ字にする。
＞mmさん
手元に環境がないので試していませんが、次のようにしてはいかがでしょうか。
（１）
「Const zentai_row_bottom = 11」の部分を
Const zentai_row_bottom = 100
のように変更します。
最大行数を超える、適当に大きな数値に書き換えれば、毎回変える必要はないと思います。
（２）
「Const siten_col = 1」の下に
Const siten_roman_col = 2
を挿入します。
「fn = sitenmei & “.xlsx”」を
sitenmei_roman = Sheets(“支店リスト”).Cells(siten_row, siten_roman_col)
fn = sitenmei_roman & “.xlsx”
に書き換えます。
試していただけると幸いです。
stabuckyさん
回答ありがとうございます。
sitenmei_roman = Sheets(“支店リスト”).Cells(siten_row, siten_roman_col)のところで
「インデックスが有効範囲にありません。」で止まってしまいます…。
ひょっとするとダブルクォートが半角でないかもしれません。「支店リスト」を挟むダブルクォートを半角にしてみてください。
半角にしていましたが、再度入力してみても同じ結果になります…。
そうですか。他に原因を思いつきません。申し訳ありません。
mmさん
「「支店リスト」シートのB列にローマ字の支店名を作り、ファイル名をこのローマ字にする。」の部分ですが、ようやく実機で試すことができました。
コード全体を貼ります。
Sub リスト分割()
Const zentai_row_top = 2 ‘全体リストのレコードの最初の行
Const zentai_row_bottom = 11 ‘全体リストのレコードの最後の行
Const zentai_col_siten = 2 ‘全体リストの支店名がある列
Const siten_col = 1 ‘支店リストの支店名がある列
Const siten_roman_col = 2 ‘支店リストの支店名(ローマ字)がある列
siten_row = 1
sitenmei = Sheets(“支店リスト”).Cells(siten_row, siten_col)
sitenroman = Sheets(“支店リスト”).Cells(siten_row, siten_roman_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 = sitenroman & “.xlsx”
ActiveWorkbook.SaveAs Filename:=fn
ActiveWorkbook.Close
siten_row = siten_row + 1
sitenmei = Sheets(“支店リスト”).Cells(siten_row, siten_col)
sitenroman = Sheets(“支店リスト”).Cells(siten_row, siten_roman_col)
Loop While sitenmei <> “”
End Sub
stabuckyさん
出来ました！
お時間割いて頂きありがとうございました。
mmさん
できましたか！とても嬉しいです。