[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『1つのワークシートを複数のブックに作成保存』（ボヤッキー）
質問させてください。
あるワークシート（3000行程度）を毎回オートフィルターで支店を選択チェックして
コピーし、支店毎に新しいブックを作成し保存しているのですが、これをマクロ？VBA？を組み、
処理できたら、軽減できないかなと考えております。
ID 商品コード 支店 色 価格 在庫数 年月
1 A-1-2 新宿 赤 2120 202201
2 A-2-1 横浜 青 4144 202201
3 A-2-3 新宿 黄 7654 202201
4 B-1-2 大阪 青 1221 202201
5 C-1-1 横浜 赤 5450 202201
3000 E-2-4 仙台 紫 6544
このシートの支店は営業所数でおおよそ100店舗ほどあるとします。
店舗数100店舗分のブックを作成し、保存をかけたいです。
この時、ブックの保存名は支店名と年月で保存をしたいです。
ID 商品コード 支店 色 価格 在庫数 年月
2 A-2-1 横浜 青 4144 202201
5 C-1-1 横浜 赤 5450 202201
ブック名 （横浜支店202201）それぞれの支店名×100店舗
ファイルサーバー内の特定フォルダに格納した後、各支店の担当者が
在庫数を入力しおわったと仮定し、
その後、各支店の複数ブック（100店舗）を1本のワークシートにまとめたいです。
当方はマクロやVBAに関して初心者です。よろしくお願いします。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
こんばんわ。＾＾ 色々方法は有りますが、アドバンスドフイルターがうってつけみたいっすよ！ これ マクロで処理すれば早くて簡単、VBA練習にはもってこいの教材の様な気が。。。 ｗ。とはいうう物の。。。100ブック保存するだけでもそれなりのお時間はかかりソぉですね(￣▽￣) ポイントは、ブックとシートを明確にすればよいかと。。。＾＾； 頑張ってくださいませ。。。でわ m(_ _)m （隠居Z） 2022/01/15(土) 18:23
＞当方はマクロやVBAに関して初心者です。
まずは、【マクロの記録】というものがあるのでそれを使って以下の作業をコード化してみてください。
・オートフィルターで支店を選択 ・コピーし ・支店毎に新しいブックを作成し保存（ブックの保存名は支店名と年月で保存）
つぎに得られたコードを【ステップ実行】して、どの命令が何かをしているのか調べてみてください。
そうすれば、必要な命令が何であるかは大体あたりが付けられます。
繰り返しの部分（マクロの記録では得られない部分）は、↑が大体理解できてから考えたほうが良いと思います。
（もこな２） 2022/01/15(土) 18:28
ありがとうございます。
なるほどアドバンスドフイルターですか。
今いろいろと作業を軽減できないかといじってみてはいるのですが。
おっしゃる通りで、同じ作業を100回近く繰り返している事じたい、省けるかと・・
マスターとなる加工元ブックで複数シートを作るか？そのまま新規ブックでコピーして保存をかけれるか？という事がポイントとの認識でよろしいのでしょうか？
ヒントありがとうございます。頑張りますｍ（・・）ｍ
（ボヤッキー） 2022/01/16(日) 11:22
ありがとうございます。
マクロでコード化ですね。慣れない事なので、やってみています。
1まず加工元シートをマクロで実行
2マクロで記述されたコードをステップ実行毎でどのような命令がされているのか理解
3理解したうえで繰り返し作業を・・
まずは加工元のシートで1・2がどのような処理のコードが得られるのか見てみます。
なにせ慣れていないので道のりは長そうです。
ありがとうございます。ｍ（ ）ｍ
（ボヤッキー） 2022/01/16(日) 11:22
なお、繰り返しになりますが、コードの検証をするには【ステップ実行】という方法をつかうとよいとおもいます。
特に確認が無かったので既に御承知かもしれませんが提示しておきます。
【ステップ実行】 https://www.239-programing.com/excel-vba/basic/basic023.html http://plus1excel.web.fc2.com/learning/l301/t405.html
【ブレークポイント】 https://www.239-programing.com/excel-vba/basic/basic022.html https://www.tipsfound.com/vba/01010
また、以下も知っておいて損は無いと思います。
【イミディエイトウィンドウ】 https://www.239-programing.com/excel-vba/basic/basic024.html https://excel-ubara.com/excelvba1/EXCELVBA486.html
【ローカルウィンドウ】 https://excel-ubara.com/excelvba4/EXCEL266.html http://excelvba.pc-users.net/fol8/8_2.html
私の解釈がまちがっているかもしれませんが、多分↓のような感じでいけるんじゃないかと思っています。
必要な命令（【】の部分です）が分かったら参考にしてみてください
Sub 分割()
Dim 支店 As Variant
Dim MyDic As Object
Dim i As Long
Set MyDic = CreateObject("Scripting.Dictionary")
With Worksheets("元データ")
'▼支店リストを取得する
On Error Resume Next
For i = 2 To .Cells(.Rows.Count, "C").End(xlUp).Row
MyDic.Add .Cells(i, "C").Value, ""
Next i
On Error GoTo 0
.AutoFilterMode = False
.Range("A:G").【オートフィルタを設定する命令】
End With
With Worksheets("元データ").AutoFilter.Range
'▼支店リストに沿って繰り返し
For Each 支店 In MyDic.keys
.【オートフィルタで抽出する命令】 Field:=3, Criteria1:=支店
【新規ブックを追加する命令】
.【セル（範囲）をコピーする命令】 Workbooks(Workbooks.Count).Worksheets(1).Range("A1")
Workbooks(Workbooks.Count).【名前を付けて保存する命令】 _
Filename:=ThisWorkbook.Path & 支店 & Format(Date, "yyyymm")
Workbooks(Workbooks.Count).【ブックを閉じる命令】 False
Next 支店
End With
End Sub
'---------------------------------------------------------------------------------------------------------
Sub 集約()
Dim ファイル名 As String
'▼項目行をコピー
Worksheets("元データ").Rows(1).Copy Worksheets("集計結果").Range("A1")
'▼処理していないブックがなくなるまで繰り返し
ファイル名 = Dir(ThisWorkbook.Path & "\*.xls?")
Do Until ファイル名 = ""
If ファイル名 <> ThisWorkbook.Name Then
With 【ブックを開く命令】(ThisWorkbook.Path & "\" & ファイル名).Worksheets(1)
Intersect(.UsedRange, .UsedRange.Offset(1)).【セル（範囲）をコピーする命令】 _
ThisWorkbook.Worksheets("集計結果").Cells(Rows.Count, "A").End(xlUp).Offset(1)
Workbooks(ファイル名).【ブックを閉じる命令】 False
End With
End If
ファイル名 = Dir()
Loop
End Sub
（もこな２） 2022/01/16(日) 13:06
ありがとうございます。
ステップ実行は黄色くなりますが、おそらく見解としては一つ一つの命令が
コードで認識できると思っております。もこなさんのおっしゃる「命令のあたりがわかる」とし、進めていく認識でおります。
【ブレークポイント】【イミディエイトウィンドウ】【ローカルウィンドウ】
補足ありがとうございます。
本来使用しているエクセルのバージョンよりも、今使えるエクセルがだいぶ古いバージョンでしかできる環境にないので、コードもだいぶ違うかもしれません。すみません。
慣れないなりに、マクロで記述されたコードはこのようなコードになりました。
これを支店分数ブックを作るようにしたいのです。
Sub 支店別1()
'
' 支店別1 Macro
'
'
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="新宿"
Range("A1:G21").Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
ChDir "C:\〇〇\●●\在庫入力作成"
ActiveWorkbook.SaveAs Filename:="C:\〇〇\●●\在庫入力作成\新宿支店.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Selection.AutoFilter Field:=3
Range("A1").Select
Selection.AutoFilter
ActiveWorkbook.Save
End Sub
ですが、もこな2さんはもう全支店の各ブック名で保存できるような記述になっていると認識すればよいみたいですね・・
古いバージョンでのコードですみません。おそらく命令はこのような流れなのかと思われます。
（ボヤッキー） 2022/01/16(日) 18:01
Sub 分割()
Dim 支店 As Variant
Dim MyDic As Object
Dim i As Long
Set MyDic = CreateObject("Scripting.Dictionary")
With Worksheets("元データ")
On Error Resume Next
For i = 2 To .Cells(.Rows.Count, "C").End(xlUp).Row
MyDic.Add .Cells(i, "C").Value, ""
Next i
On Error GoTo 0
.AutoFilterMode = False
.Range("A:G").AutoFilter '←★【オートフィルタを設定する命令】
End With
With Worksheets("元データ").AutoFilter.Range
For Each 支店 In MyDic.keys
.AutoFilter Field:=3, Criteria1:=支店 '←★【オートフィルタで抽出する命令】
Workbooks.Add '←★【新規ブックを追加する命令】
.Copy Workbooks(Workbooks.Count).Worksheets(1).Range("A1") '←★ 【セル（範囲）をコピーする命令】
Workbooks(Workbooks.Count).SaveAs _
Filename:="C:\〇〇\●●\在庫入力作成\" & 支店 & Format(Date, "yyyymm") '←★【名前を付けて保存する命令】
Workbooks(Workbooks.Count).Close False '←★オマケ【ブックを閉じる命令】
Next 支店
End With
End Sub
次は、ブックを1つ開き、集約用のシートにコピペをする作業を【マクロの記録】でコード化して同じように、必要な命令に当たりを付けてみましょう。
（もこな２） 2022/01/16(日) 21:02
こんばんわ。＾＾ 大雑把な説明で、済みませんでした。
＞＞ブックの保存名は支店名と年月で保存をしたいです｡
ということは。5000件の情報は全て一月分で、100店舗なので 100ブック。従って年月は全て同じ。と！、理解して良いので せうか。。。ちなみに1年分だと。100店舗×12＝1200ブックに＾＾； ？<< _ _ >> （隠居Z） 2022/01/16(日) 21:30
（マナ） 2022/01/16(日) 21:56
ありがとうございます。
やっといじれる時間が・・m(..)m
あたりをつけながら その後、（分割）でやってみたらできました。
もこな２さんありがとうございます。
入力が終わった複数ブックを1本にまとめる作業をコード化をしてみます。
（ボヤッキー） 2022/01/19(水) 23:00
支店〇〇年●月毎を毎月支店文数行います。
なので、100店舗だとすると、1年だと12か月×100店舗分のブック数にトータルではなると思います。
マナさま
実は共有設定は考えました。（1本のデーターベース）
ですが、各支店ごとにブックを分けます。
（ボヤッキー） 2022/01/25(火) 23:11
Sub 集約()
集約 Macro
Range("A1:G1").Select
Selection.Delete Shift:=xlUp
Range("A1:G5").Select
Selection.Copy
Windows("在庫データー集約.xls").Activate
Range("A2").Select
ActiveSheet.Paste
Range("A2").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub
仮に在庫データー集約.xlsブックの集約シートに各支店の規則的な名前の〇〇支店202201のデータを支店ぶんの数を集約シートにコピーして貼り付けをします。
元データと集約シートのデータ件数は同じです。
また最初の、元データを複数のブックに保存する前の段階で、複数ブックのセルの列幅を広げて（データが隠れて見えない場合）見えるようにして、在庫数を入力する以外はシートの保護をかけ、その他のデータを削除してしまったり、変更ないようなやり方もあるのでしょうか？
どの段階で保護をかけるべきかおそらくですが、★ 【セル（範囲）をコピーする命令】後の保存前のような気がしてはいるのですが・・
（ボヤッキー） 2022/01/25(火) 23:14
・ブックを開くところも【マクロの記録】で得られると思いますよ。 ・1行目を削除するのは要らないと思いますよ（2行目以降をコピーすればいいだけなので） ・データを移し終わったブックは、（保存せずに）閉じたらいいと思いますよ
追加の質問について
＞セルの列幅を広げて（データが隠れて見えない場合）見えるようにして
AutoFitを使えばよいですね。 https://www.moug.net/tech/exvba/0050001.html
＞在庫数を入力する以外はシートの保護をかけ
在庫数の列（F列ですかね）だけ「ロック」を外して保護すればよいですね （保護する命令も、【マクロの記録】で得られます）
とはいえ、いずれもベースとなる分割と集約のマクロが一通り完成してからにされてはどうですか？
同時進行すると混乱して余計に時間がかかっちゃうことが懸念されます。
（もこな２） 2022/01/26(水) 08:26
ありがとうございます。
各ブックを開くところから再度やってみます。
2行目以降をコピーし、そのまま各ブックを閉じるですね。
AutoFitですね。おっしゃる通り別のマクロを同時に考えると混乱してしまいますね。
まずはしっかりと分割できるようにしたいと思います。（理解も含めて）
取り急ぎですが、ありがとうございます。
（ボヤッキー） 2022/01/26(水) 21:50
"元データ"シートの入力をしたい列の保護ロックを解除し
【セル（範囲）をコピーする命令】直後
Copy Workbooks(Workbooks.Count).Worksheets(1).Range("A1")
Columns("A:E").EntireColumn.AutoFit
ActiveSheet.Protect Password:="〇〇××"
Workbooks(Workbooks.Count).SaveAs _
としたら、できました。
正直驚きと感動です。
ありがとうございます m（ ）m
（ボヤッキー） 2022/01/29(土) 15:35
1.【分割】マクロの完成 ← 済 2.【集約】マクロの完成 ← まだ 3.【分割】マクロの改造 ← ↑なのに手を付けた
こうなってますよね。
（もこな２） 2022/01/29(土) 18:43
集約に関してのコードがこのようになりました。
おそらく無駄な動きとかあるかもしれませんが・・
Sub 集約()
ActiveWindow.SmallScroll Down:=-12
Workbooks.Open Filename:="C:\〇〇\●●\Desktop\在庫データまとめ\△△支202201.xls" '←【フォルダ内の各支店ブックをしていしたい】
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("在庫データー集約.xls").Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A2").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
Windows("△△支店202201.xls").Activate
ActiveWindow.Close
End Sub
ステップインで動きは確認してみました。
（ボヤッキー） 2022/01/29(土) 20:31
＞分割を先に完成してからと勘違いをしておりました。
そういうことであれば分割のほうを先に完成させるのは理解できますが、既にコメントしたように在庫数の列のロックを解除しないと支店の人が入力できないとおもいます。
Sub 分割()
Dim 支店 As Variant
Dim MyDic As Object
Dim i As Long
Set MyDic = CreateObject("Scripting.Dictionary")
With Worksheets("元データ")
On Error Resume Next
For i = 2 To .Cells(.Rows.Count, "C").End(xlUp).Row
MyDic.Add .Cells(i, "C").Value, ""
Next i
On Error GoTo 0
.AutoFilterMode = False
.Range("A:G").AutoFilter
End With
With Worksheets("元データ").AutoFilter.Range
For Each 支店 In MyDic.keys
.AutoFilter Field:=3, Criteria1:=支店
Workbooks.Add
.Copy Workbooks(Workbooks.Count).Worksheets(1).Range("A1")
With Workbooks(Workbooks.Count)
.Worksheets(1).Columns("A:E").EntireColumn.AutoFit
.Worksheets(1).Columns("F:F").Locked = False '←★【ロックを解除する命令】
.Worksheets(1).Protect Password:="〇〇××"
.SaveAs Filename:="C:\〇〇\●●\在庫入力作成\" & 支店 & Format(Date, "yyyymm")
.Close False
End With
Next 支店
End With
End Sub
＞集約に関してのコードがこのようになりました。
＞ステップインで動きは確認してみました。
必要な命令はわかりましたか？
「2022/01/16(日) 13:06」に提示したコードをちょっと改造して当てはめるとこんな感じになったと思います。
Sub 集約()
Dim ファイル名 As String
Dim フォルダパス As String
フォルダパス = "C:\〇〇\●●\Desktop\在庫データまとめ\"
'▼項目行をコピー
Worksheets("元データ").Rows(1).Copy Worksheets("集計結果").Range("A1")
'▼処理していないブックがなくなるまで繰り返し
ファイル名 = Dir(フォルダパス & "\*.xls?")
Do Until ファイル名 = ""
If ファイル名 <> ThisWorkbook.Name Then
With Workbooks.Open(Filename:=フォルダパス & ファイル名).WorkIdentity(1) '【ブックを開く命令】
Intersect(.UsedRange, .UsedRange.Offset(1)).Copy _
ThisWorkbook.Worksheets("集計結果").Cells(Rows.Count, "A").End(xlUp).Offset(1) '【セル（範囲）をコピーして貼付する命令】
Workbooks(ファイル名).Close False '【ブックを閉じる命令】
End With
End If
ファイル名 = Dir()
Loop
End Sub
（もこな２） 2022/02/07(月) 05:03
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.