[[20200505132744]]　『VBA Ifの使い方』（ゆう）　ページの最後に飛ぶ

『VBA Ifの使い方』（ゆう）

"メニュー"シートのA2より下にシート一覧が記載しています。
B列にフラグを立て、フラグがあるシートは新しいブックへ追加されるコードを作成しました。
B列に何もフラグが立ってないときは、メッセージボックスを出したいのですが、どのようなコードを追加したらよろしいでしょうか？

よろしくお願い致します。

Sub サンプル()

 Dim i As Long
 Dim wb As Workbook

　　　 With ThisWorkbook.Worksheets("メニュー")

            For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
                If .Cells(i, "B") <> "" Then
                    Set wb = Workbooks.Add
                    ThisWorkbook.Worksheets(.Cells(i, "A").Value).Copy After:=wb.Sheets(Sheets.Count)
                End If
            Next i
        End With

Application.DisplayAlerts = False
wb.Sheets(1).Delete
Application.DisplayAlerts = True

End Sub

＜使用 Excel：unknown、使用 OS：unknown ＞

回答ではありません。
これは、ループの外でよいのでしょうか。

 ＞wb.Sheets(1).Delete

（マナ） 2020/05/05(火) 13:43

↓このトピックの続きですよね。
[[20200429172556]]　『VBA　シートコピー　一覧』（ゆう）

質問とは関係ないですが、マナさんの指摘に加えて「Set wb = Workbooks.Add」がループ内にあるで、当初の目的を満たせなくなるのでは？

＞B列に何もフラグが立ってないときは、メッセージボックスを出したい。
B列に何か入っているセルの数を数えて0だったらメッセージを表示とすればよいでしょう

（もこな２） 2020/05/05(火) 14:04

マナさん

＞wb.Sheets(1).Deleteはループの外でよいです。
私が書いた位置が間違っていました。

もこな２さん

いつもありがとうございます。
＞B列に何か入っているセルの数を数えて0だったらメッセージを表示とすればよいでしょう

そのような方法があるのですね！
この方法でコード考えてみます。
（ゆう） 2020/05/05(火) 14:43

＞そのような方法があるのですね！
ワークシート関数に目を向けてみましょう。

また、B列の最終行をしらべて１行目（項目行）だったら、フラグは無いという判定も可能じゃないでしょうか？

   Sub 実験01()

      MsgBox WorksheetFunction.CountA(Range("B2:B100")) & "個のセルにフラグがあります。"

      If Cells(Rows.Count, "B").End(xlUp).Row = 1 Then
         MsgBox "フラグがたっているセルはありません。"
      End If

   End Sub

＞私が書いた位置が間違っていました。
マナさんの指摘しているほう"だけ"間違えたということなら、いちいち新規ブックを作ってからコピーして、新規ブックを作った時にもともとあったシートを削除するんじゃなくて、挿入先を指定せずにシートをコピーすれば同じことになりません？（前トピックで提示済み）

（もこな２） 2020/05/05(火) 16:25

もこなさん
ありがとうございます。

＞B列に何か入っているセルの数を数えて0だったらメッセージを表示とすればよいでしょう

下記コードを作成してみました。

Sub テスト()

    Dim n As Long
    n = WorksheetFunction.CountIf(Range("B2:B1000"), "<>")

      If n = "0" Then
        MsgBox "未入力箇所があります。"
      End If

End Sub

＞挿入先を指定せずにシートをコピーすれば同じことになりません？

もこなさんに教えて頂いたコードに上記をどのように追加すればいいのでしょうか？

Sub ブックに追加する()

        Dim i As Long
        Dim WB As Workbook
        Stop
        With ThisWorkbook.Worksheets("メニュー")
            For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
                If .Cells(i, "B") <> "" Then
                    If WB Is Nothing Then
                        ThisWorkbook.Worksheets(.Cells(i, "A").Value).Copy
                        Set WB = Workbooks(Workbooks.Count)
                    Else
                        ThisWorkbook.Worksheets(.Cells(i, "A").Value).Copy After:=WB.Worksheets(WB.Worksheets.Count)
                    End If
                End If
            Next
        End With
    End Sub
（ゆう） 2020/05/05(火) 16:38

作成してみました。
いかかでしょうか？

Sub 作成()

        Dim i As Long
        Dim WB As Workbook

        Dim n As Long
        n = WorksheetFunction.CountIf(Range("B2:B1000"), "<>")

       If n = "0" Then
        MsgBox "未入力箇所があります。"
        Exit Sub

        Else

        With ThisWorkbook.Worksheets("【シート一覧】")
            For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
                     If .Cells(i, "B") <> "" Then
                            If WB Is Nothing Then
                               ThisWorkbook.Worksheets(.Cells(i, "A").Value).Copy
                               Set WB = Workbooks(Workbooks.Count)
                            Else
                               ThisWorkbook.Worksheets(.Cells(i, "A").Value).Copy After:=WB.Worksheets(WB.Worksheets.Count)
                            End If
                     End If

            Next
        End With
        End If

End Sub
（ゆう） 2020/05/05(火) 17:38

＞作成してみました。
＞いかかでしょうか？

で実行したらどうなったんですか。不具合があるんですか。
（ｙｕ） 2020/05/05(火) 18:23

不具合はなかったです。

思う通りに動きました。

いつも教えて頂き、ありがとうございます。
（ゆう） 2020/05/05(火) 19:05

どうも話がかみ合ってないようですが、結局、シートごとにブックを作成するのはマズかったんのでしょうか？（その部分の返事がないまま、私が提示したコードを流用されていますが・・・）

ｙｕさんのコメントに対するレスを拝見する限り、問題がないならそれでよいのではないかと私も思いますが、強いてツッコミをいれるとすれば。

 「未入力箇所があります。」ではなく、「どのシートも指定されてません」ではないでしょうか？

 インデントの位置はそれで見やすいのでしょうか？

 流用されるのは結構なんですが、ステップ実行して、それぞれのコードの意味は理解されてますか？
 (よくわからないけど動いたのでパクリましたとかであれば、流用するのは止めていただきたいです）

（もこな２） 2020/05/06(水) 00:53

もこなさん

説明不足で申し訳ありません。
私の今回の目標は、フラグが立っているシートを1つのブックにコピーしていくという事でした。
このトピの最初に記載した、新規ブックを作りそのブックにコピーしていき、一番左のシートを削除するというコードはもこなさんのいう通り
＞「Set wb = Workbooks.Add」がループ内にあるで、当初の目的を満たせなくなるのでは？
確かにループ内にあれば、目的を満たせません。
もこなさんの指摘で気づきました。

＞挿入先を指定せずにシートをコピーすれば同じことになりません？（前トピックで提示済み）
急に流用して申し訳ありません。
（ゆう） 2020/05/06(水) 09:58

＞「未入力箇所があります。」ではなく、「どのシートも指定されてません」ではないでしょうか？
言葉選びが間違っておりました。

＞インデントの位置はそれで見やすいのでしょうか？
まだコードを書き慣れていないので、インデックスの位置は今後気にしていくようにします。

＞流用されるのは結構なんですが、ステップ実行して、それぞれのコードの意味は理解されてますか？
意味は理解できています。
まだまだ初心者なので今後VBAをもっと学んで参ります。
（ゆう） 2020/05/06(水) 10:02

レスを頂いたようなのでコメントします。

つまり、複数のシートにフラグがたっている場合、バラバラにブックにされると困るんですね。
その場合、前トピックでご自身が作成されたコードでも正解にたどり着いていましたから、そちらをベースにされてもよかったと思います。

   Sub 作成_改()
      Dim i As Long
      Dim wb As Workbook
      Dim 最終行 As Long

      With ThisWorkbook.Worksheets("【シート一覧】")
         最終行 = .Cells(.Rows.Count, "A").End(xlUp).Row

         If 最終行 = 1 Then
            MsgBox "どのシートも選択されてません"
         Else

            '▼新規ブックを用意して、フラグがたっているシートをコピー挿入する
            Set wb = Workbooks.Add
            For i = 2 To 最終行
               If .Cells(i, "B") <> "" Then
                  ThisWorkbook.Worksheets(.Cells(i, "A").Value).Copy After:=wb.Sheets(Sheets.Count)
               End If
            Next i

            '▼用意した新規ブックに元からあったシートを削除する。
            Application.DisplayAlerts = False ' メッセージを非表示
            For i = Application.SheetsInNewWorkbook To 1 Step -1
               wb.Worksheets(i).Delete
            Next i
            Application.DisplayAlerts = True ' メッセージを表示
         End If
      End With
   End Sub

（もこな２） 2020/05/06(水) 14:03

もこなさん

コードご教授いただき、ありがとうございます。
新規ブック作成のコードでもよかったのですね。

このトピ最初に記載したコードでは
Set wb = Workbooks.Add
の位置がループ内でダメだったんですね。

まだまだ知識不足なので、もっと勉強して参ります。
いつもありがとうございます。
（ゆう） 2020/05/06(水) 16:26

コメント返信：

[ 一覧(最新更新順) ]

[[20200505132744]] 『VBA Ifの使い方』（ゆう） ページの最後に飛ぶ

[[20200505132744]]　『VBA Ifの使い方』（ゆう）　ページの最後に飛ぶ