[[20220114200618]] 『1つのワークシートを複数のブックに作成保存』(ボヤッキー) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『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練習にはもってこいの教材の様な気が。。。
w。とはいうう物の。。。100ブック保存するだけでもそれなりのお時間はかかりソぉですね( ̄▽ ̄)
ポイントは、ブックとシートを明確にすればよいかと。。。^^;
頑張ってくださいませ。。。でわ
m(_ _)m
(隠居Z) 2022/01/15(土) 18:23

編集がかぶってしまいましたがそのまま。

>当方はマクロやVBAに関して初心者です。
まずは、【マクロの記録】というものがあるのでそれを使って以下の作業をコード化してみてください。

 ・オートフィルターで支店を選択
 ・コピーし
 ・支店毎に新しいブックを作成し保存(ブックの保存名は支店名と年月で保存)

つぎに得られたコードを【ステップ実行】して、どの命令が何かをしているのか調べてみてください。
そうすれば、必要な命令が何であるかは大体あたりが付けられます。

繰り返しの部分(マクロの記録では得られない部分)は、↑が大体理解できてから考えたほうが良いと思います。

(もこな2) 2022/01/15(土) 18:28


隠居Zさま

ありがとうございます。

なるほどアドバンスドフイルターですか。
今いろいろと作業を軽減できないかといじってみてはいるのですが。

おっしゃる通りで、同じ作業を100回近く繰り返している事じたい、省けるかと・・
マスターとなる加工元ブックで複数シートを作るか?そのまま新規ブックでコピーして保存をかけれるか?という事がポイントとの認識でよろしいのでしょうか?

ヒントありがとうございます。頑張りますm(・・)m
(ボヤッキー) 2022/01/16(日) 11:22


もこな2さま

ありがとうございます。
マクロでコード化ですね。慣れない事なので、やってみています。

1まず加工元シートをマクロで実行
2マクロで記述されたコードをステップ実行毎でどのような命令がされているのか理解

3理解したうえで繰り返し作業を・・

まずは加工元のシートで1・2がどのような処理のコードが得られるのか見てみます。

なにせ慣れていないので道のりは長そうです。
ありがとうございます。m( )m
(ボヤッキー) 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

(もこな2) 2022/01/16(日) 13:06


もこな2さま

ありがとうございます。

ステップ実行は黄色くなりますが、おそらく見解としては一つ一つの命令が
コードで認識できると思っております。もこなさんのおっしゃる「命令のあたりがわかる」とし、進めていく認識でおります。

【ブレークポイント】【イミディエイトウィンドウ】【ローカルウィンドウ】
補足ありがとうございます。

本来使用しているエクセルのバージョンよりも、今使えるエクセルがだいぶ古いバージョンでしかできる環境にないので、コードもだいぶ違うかもしれません。すみません。

慣れないなりに、マクロで記述されたコードはこのようなコードになりました。
これを支店分数ブックを作るようにしたいのです。

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つ開き、集約用のシートにコピペをする作業を【マクロの記録】でコード化して同じように、必要な命令に当たりを付けてみましょう。

(もこな2) 2022/01/16(日) 21:02


 こんばんわ。^^
大雑把な説明で、済みませんでした。

>>ブックの保存名は支店名と年月で保存をしたいです。

 ということは。5000件の情報は全て一月分で、100店舗なので
100ブック。従って年月は全て同じ。と!、理解して良いので
せうか。。。ちなみに1年分だと。100店舗×12=1200ブックに^^;
?<< _ _  >>
(隠居Z) 2022/01/16(日) 21:30

そもそもですが、分割せずに、共有設定にするだけではだめなのでしょうか。

(マナ) 2022/01/16(日) 21:56


もこな2さま

ありがとうございます。
やっといじれる時間が・・m(..)m

あたりをつけながら その後、(分割)でやってみたらできました。
もこな2さんありがとうございます。

入力が終わった複数ブックを1本にまとめる作業をコード化をしてみます。

(ボヤッキー) 2022/01/19(水) 23:00


隠居Zさま

支店〇〇年●月毎を毎月支店文数行います。
なので、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


「2022/01/25(火) 23:14」に投稿されたコードを拝見して。
 ・ブックを開くところも【マクロの記録】で得られると思いますよ。
 ・1行目を削除するのは要らないと思いますよ(2行目以降をコピーすればいいだけなので)
 ・データを移し終わったブックは、(保存せずに)閉じたらいいと思いますよ

追加の質問について
>セルの列幅を広げて(データが隠れて見えない場合)見えるようにして

 AutoFitを使えばよいですね。
https://www.moug.net/tech/exvba/0050001.html

>在庫数を入力する以外はシートの保護をかけ

 在庫数の列(F列ですかね)だけ「ロック」を外して保護すればよいですね
(保護する命令も、【マクロの記録】で得られます)

とはいえ、いずれもベースとなる分割と集約のマクロが一通り完成してからにされてはどうですか?
同時進行すると混乱して余計に時間がかかっちゃうことが懸念されます。

(もこな2) 2022/01/26(水) 08:26


もこな2さま

ありがとうございます。
各ブックを開くところから再度やってみます。
2行目以降をコピーし、そのまま各ブックを閉じるですね。

AutoFitですね。おっしゃる通り別のマクロを同時に考えると混乱してしまいますね。

まずはしっかりと分割できるようにしたいと思います。(理解も含めて)

取り急ぎですが、ありがとうございます。

(ボヤッキー) 2022/01/26(水) 21:50


もこな2さま

"元データ"シートの入力をしたい列の保護ロックを解除し

【セル(範囲)をコピーする命令】直後

 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.【分割】マクロの改造 ← ↑なのに手を付けた

こうなってますよね。

(もこな2) 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

(もこな2) 2022/02/07(月) 05:03


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.