Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10全般 : その他)
マスターブック内の同一条件のシート全てを新規ブックに保存
投稿日時: 21/10/01 12:01:57
投稿者: よる

初めて投稿します。宜しくお願いいたします。
100 近くシートのあるマスターブック内の@4シート目から最後まで、
A各シートD1の店番と、マスターシートに入っている店番(C列)とを照合し、
Aが一致している間は同一の新規ブックにシートをコピペ、
Aが異なった場合はそれまでのブックを名前付けて保存、という処理をしたいと思っています。
(店番1のシートは店番1のブックにまとめて、…というような感じです)
 
For内をさんざん手直ししましたが、望み通りの処理ができず悩んでおります。
どなたかお力をお貸し頂けないでしょうか。
 
バージョンはMicrosoft365、
コードは下記になります。
 
 
Sub 店舗ごとのブック保存()
Application.ScreenUpdating = False
 
'iはマスターブックのシート番号変数
Dim i As Long
i = 4 'iの値をリセット
'jはマスターシート3列目店番
Dim j As Long
j = 1
'kは新規ブックのシート数
Dim k As Long
k = 1
 
'ブック、シートをオブジェクト変数に格納
Dim wb As Workbook
Set wb = ThisWorkbook
Dim allsheets As Long
allsheets = wb.Sheets.Count
 
'master はマクロに使うマスターシート
Dim master As Worksheet
Set master = wb.Worksheets("マスター")
 
'path はこのマクロファイルのフルパス
Dim path As String
path = ThisWorkbook.path
Debug.Print path
 
'以下 処理部--------------------------------------------------------------------------
Select Case MsgBox("店舗別ファイルを出力しますか?", vbYesNo)
'yesならシートごとにファイル名付けて保存して閉じる
Case vbYes
 
    For i = 4 To allsheets
        '照合に使う文字列2つセット
        Dim shNm As String 'shNm はマスターブック各シートの店番D1
        shNm = wb.Worksheets(i).Range("D1").Value
        Dim masNm As String 'masNm はマスターシートのC列店番
        masNm = master.Cells(j, 3).Value
        Debug.Print shNm
        Debug.Print masNm
         
        If shNm = masNm Then
        '新規ブック開く
        Dim newbook As Workbook
        Set newbook = Workbooks.Add
         
            Do While shNm = masNm
                wb.Worksheets(i).Copy before:=newbook.Worksheets(k)
                k = k + 1
            Loop
        Else
            newbook.SaveAs Filename:=path & "\" & master.Cells(j, 1) & ".xlsx"
            newbook.Close
         
            j = j + 1
        End If
    Next i
             
         
     
Case vbNo
    MsgBox "出力を中止しました"
End Select
 
Application.ScreenUpdating = True
End Sub
 

回答
投稿日時: 21/10/01 12:48:08
投稿者: WinArrow
投稿者のウェブサイトに移動

ステップ実行をお勧めします。
 
ステップ実行する音で、
意図した動きになっているかを確認できます。
その時の変数の値を確認すれば、ロジック間違いを発見できると思います。

投稿日時: 21/10/01 12:52:03
投稿者: よる

コメントありがとうございます。
ステップ実行F8を何度も繰り返し修正に修正を重ねたうえでの投稿になります。
力不足故に、どこをどう直したら希望通りの処理になるか分かりませんでした。
 
上記コードの修正点がわかる方、お力を貸して頂けますと幸いです。

回答
投稿日時: 21/10/01 13:10:29
投稿者: simple

されたいことの確認だけ、させてください。
 
マスターシートのC1セルを "a" としましょう。
 
4番目以降のシートの D1セルが、それぞれ

sh4    a
sh5    a
sh6    b
sh7    c
となっていたら、sh4とsh5だけをコピーしたブックを保存したい、
ということですね?
 
質問は以下です。
(1)マスターシートのC1セルだけを相手にすればいいんですか?
   書いてはいないが、それが終わったら同様に、次はC2セルについても
   といったことですか。
 
(2)とりあえず、ひとつの a についてだけ考えます。
sh4    a
sh5    a
sh6    b
sh7    a  ←ここ
といったことは無いことが保証されている、ということでいいんですか?
 
(3)
sh4    b  ← 最初から a じゃない。  
sh5    b
sh6    a
sh7    a
sh8    b
といったことは無いと考えていいのですか?
 
まずは、上記の確認事項に回答してもらえますか?
 
全体の方針ですが、、
・シートひとつずつ判断して、同一ならコピーするという作業を、
  最初(4番目)のシートからから最後まで行う。
・それが終わった時点で保存する。
という簡単な処理の仕組みにしておくのが、間違いが無いと思います。

回答
投稿日時: 21/10/01 13:47:46
投稿者: simple

文章による説明を読んだ限りでの質問をしました。
その後、コードを拝見しました。
全体の流れは以下のような感じではないですか?
考え方を書いたもので、実際に動かして確認したものではありません。
考え方を理解してもらって、あなたのコードに反映してみてください。
 

Sub 店舗ごとのブック保存()
    Dim wb      As Workbook
    Dim master  As Worksheet
    Dim path    As String
    Dim masNm   As String    'マスターシートのC列店番
    Dim newbook As Workbook
    Dim shNm    As String
    Dim i       As Long
    Dim j       As Long
    Dim k       As Long

    Application.ScreenUpdating = False
    'ブック、シートをオブジェクト変数に格納
    Set wb = ThisWorkbook

    'master はマクロに使うマスターシート
    Set master = wb.Worksheets("マスター")

    'path はこのマクロファイルのフルパス
    path = ThisWorkbook.path

    For j = 1 To master.Cells(Rows.Count, 3).End(xlUp).Row
        masNm = master.Cells(j, 3).Value
        Set newbook = Workbooks.Add

        For i = 4 To wb.Sheets.Count
            shNm = wb.Worksheets(i).Range("D1").Value
            If shNm = masNm Then
                wb.Worksheets(i).Copy after:=newbook.Worksheets(newbook.Count)
            End If
        Next i
        newbook.SaveAs Filename:=path & "\" & master.Cells(j, 1) & ".xlsx"
        newbook.Close
    Next
    Application.ScreenUpdating = True
End Sub

# 途中に変数の宣言が入ると、どうしても論理が切られてしまう感じが拭えない
# オールドタイプの人間です。ここもあなたの好きなように修正して下さい。

トピックに返信