[[20210303145217]]　『特定のシートの存在有無での構文の書き方について』（けい）　ページの最後に飛ぶ

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

　

『特定のシートの存在有無での構文の書き方について』（けい）

vbaについてどなたかご教示をお願いいたします。

＜前提条件＞
・あるブックに複数のワークシートが存在する
　→ シート名は仮に「A」「B」「C」・・・「Z」とします。
　→ シート名は固定
・マクロ実行開始時、余計なシートを削除してワークシートの初期化をしたい
　→ 「A」「B」「C」のシートはマスターデータが入っているため削除禁止
　→ 「A」「B」「C」以外のシートが存在する場合は削除する

＜上記についての現在の構文＞
Sub 月次処理シート初期化() 

  Dim targetSheet As Worksheet  '繰り返し用
  Dim DelChk As Integer  '削除確認用
  DelChk = MsgBox("初期化のためシートを削除します。この操作は元に戻せなくなりますが、削除してよろしいですか？", vbYesNo + vbExclamation, "注意！")


  If DelChk = vbYes Then
  Application.DisplayAlerts = False


  '削除処理
  For Each targetSheet In Worksheets
    If targetSheet.Name <> "A" And targetSheet.Name <> "B" And targetSheet.Name <> "C" Then
    targetSheet.Delete
    End If
  Next


  Else
  MsgBox "削除処理を中止しました。"


  Application.DisplayAlerts = True
  End If

End Sub

＜更に行いたいこと＞
・ワークシート名全てをチェックして、もしシート「A」「B」「C」しか存在しない場合は「削除対象シートはありません」とメッセージを出したいのです。
この場合、上記構文に加えてどういう構文を追加すれば良いでしょうか？
いくつか試しているのですが、上手くいかず・・・

お知恵をお借りしたく、宜しくお願い致します。

＜ 使用 Excel：Office365、使用 OS：Windows10 ＞

 判定用のBoolean型変数を使用して
Dim flag As Boolean
削除時(A･B･C以外有り)に
flag = True
最後にflag = False(初期値のまま)だったら
MsgBoxを表示する
（ はまちゃん） 2021/03/03(水) 15:13

 シート A,B,Cが必ずある前提なら、シートの数を確認すればわかるのでは？
（´・ω・`） 2021/03/03(水) 15:34
質問主旨からそれますが 

 If ... Then
 Application.DisplayAlerts = False
 Else
 Application.DisplayAlerts = True
 End If

これではもう一度削除処理をしないとDisplayAlertsが元に戻りません

閑話休題、削除シートをピックアップしてから削除処理をする案です。 

 Sub 月次処理シート初期化()
    Dim targetSheet As Worksheet  '繰り返し用
    Dim DelChk As Integer  '削除確認用
    Dim dShNames() As String
    Dim i As Long
    '削除対象シートをピックアップ
    For Each targetSheet In Worksheets
        If targetSheet.Name <> "A" And targetSheet.Name <> "B" And targetSheet.Name <> "C" Then
            ReDim Preserve dShNames(i)
            dShNames(i) = targetSheet.Name
            i = i + 1
        End If
    Next
    If i < 1 Then
        MsgBox "削除対象シートはありません"
    ElseIf i >= Worksheets.Count Then
        MsgBox "初期化エラー"
    Else
        DelChk = MsgBox("初期化のため" & vbCrLf & Join(dShNames, vbCrLf) & vbCrLf & "シートを削除します。この操作は元に戻せなくなりますが、削除してよろしいですか？", vbYesNo + vbExclamation, "注意！")
        If DelChk = vbYes Then
            '削除処理
            Application.DisplayAlerts = False
            Worksheets(dShNames).Delete
            Application.DisplayAlerts = True
        Else
            MsgBox "削除処理を中止しました。"
        End If
    End If
 End Sub

（Sinking Time） 2021/03/03(水) 15:56

　構文追加案 

        '削除処理
        (1) ■■■■■ ここで削除前のワークシート数を（任意の）変数に代入する
        For Each targetSheet In Worksheets
            If targetSheet.Name <> "A" And targetSheet.Name <> "B" And targetSheet.Name <> "C" Then
                targetSheet.Delete
            End If
        Next
        (2) ■■■■■ ここで削除後のワークシート数を(1)と比較し、同じなら 　MsgBox "削除対象シートはありません"
    Else

（チオチモリン） 2021/03/03(水) 15:59

 自前で警告するなら、Excelの機能にまかせればいいのでは。    


    Sub sample()


       Dim shName() As String


       ReDim shName(1 To Worksheets.Count)
       i = 0
       For Each ws In Worksheets
           Select Case ws.Name
             Case "A", "B", "C"
             Case Else
                i = i + 1
                shName(i) = ws.Name
           End Select
       Next
       If i = 0 Then
          MsgBox "ありません"
       Else
          ReDim Preserve shName(1 To i)
          Worksheets(shName).Delete
       End If


    End Sub
（´・ω・`） 2021/03/03(水) 16:06
皆様、短時間のうちに多々アドバイス頂戴しまして大変有り難うございます！
初めてこちらでご質問しましたが、皆様のお知恵に感嘆しています。
(vba初心者なもので、お恥ずかしい限りです)

投稿後、自分なりに調べたり色々考えてみまして・・・
ブール型変数というのでしょうか、以下の通りの構文に書き換えてみました。
こちらで試してみたところ、先ずはやりたいことが実現できているように見受けられます。
(何らかの落ち度がありましたら、ご指摘頂ければ幸いです)

皆様にご教示頂いた構文もどれも興味深いです。
Select Caseを使ったコード、シンプルで良いですね！
皆様に感謝申し上げます！！

＜改修したコード＞
Sub 月次処理用シート初期化() 

  Dim targetSheet As Worksheet  '繰り返し用
  Dim DelChk As Integer  '削除確認用
  Dim flag As Boolean


  For Each ws In Worksheets
    If ws.Name <> "★削除禁止★KPI(累計)" And ws.Name <> "★削除禁止★勤怠(累計)" And ws.Name <> "★削除禁止★メニュー" Then
        flag = True
    End If
  Next ws


  If flag = True Then
    DelChk = MsgBox("初期化のためにいくつかのシートを削除しようとしています。この操作は元に戻せなくなりますが、削除してよろしいですか？", vbYesNo + vbExclamation, "注意！")


        If DelChk = vbYes Then


        '削除処理
            For Each targetSheet In Worksheets
            If targetSheet.Name <> "★削除禁止★KPI(累計)" And targetSheet.Name <> "★削除禁止★勤怠(累計)" And targetSheet.Name <> "★削除禁止★メニュー" Then
            Application.DisplayAlerts = False
            targetSheet.Delete
            Application.DisplayAlerts = True
            End If
            Next


        Else
        MsgBox "削除処理を中止しました。"
        End If


  Else
        MsgBox "削除対象のシートはありません。"
  End If

End Sub

（けい） 2021/03/03(水) 16:59

失礼しました。
先ほどの書き込みで一部修正前の箇所がありましたので、念のため再度修正版を記載いたします。

Sub 月次処理用シート初期化() 

  Dim targetSheet As Worksheet  '繰り返し用
  Dim DelChk As String  '削除確認用
  Dim flag As Boolean  'シート存在確認用


  For Each targetSheet In Worksheets
    If targetSheet.Name <> "A" And targetSheet.Name <> "B" And targetSheet.Name <> "C" Then
        flag = True
    End If
  Next targetSheet


  If flag = True Then
    DelChk = MsgBox("初期化のためにいくつかのシートを削除しようとしています。この操作は元に戻せなくなりますが、削除してよろしいですか？", vbYesNo + vbExclamation, "注意！")


        If DelChk = vbYes Then


        '削除処理
            For Each targetSheet In Worksheets
            If targetSheet.Name <> "A" And targetSheet.Name <> "B" And targetSheet.Name <> "C" Then
            Application.DisplayAlerts = False
            targetSheet.Delete
            Application.DisplayAlerts = True
            End If
            Next


        Else
        MsgBox "削除処理を中止しました。"
        End If


  Else
        MsgBox "削除対象のシートはありません。"
  End If

End Sub

（けい） 2021/03/03(水) 17:31

　>先ずはやりたいことが実現できているように見受けられます。
　まだ問題があるということですか。
（KI） 2021/03/03(水) 17:56
横からですが。

■１
既に関連コメントがありますが、今回のケースでいえば「Application.DisplayAlerts」はループの外のほうがよいでしょう。

■２
必要なものを"残す"という考え方を変えて、全部消してから必要なものを"戻す"とすればこんな方法もありますね。 

    Sub さんぷる()
        Dim tmp As Worksheet
        Dim i As Long


        '▼全シートの削除は出来ないのでダミー用のシートを追加
        Set tmp = ThisWorkbook.Worksheets.Add(before:=ThisWorkbook.Worksheets(1))


        '▼残したいシートだけ新規ブックへ待避
        ThisWorkbook.Worksheets(Array("A", "B", "C")).Copy       


        Application.DisplayAlerts = False '確認メッセージを一時的に無効化


        '▼先頭に突っ込んだダミー用のシート以外全部削除
        For i = ThisWorkbook.Worksheets.Count To 2 Step -1
            ThisWorkbook.Worksheets(i).Delete
        Next i


        '▼待避したシートを戻す
        Workbooks(Workbooks.Count).Worksheets.Move after:=ThisWorkbook.Worksheets(1)


        '▼用済みのダミーシートを削除
        tmp.Delete


        Application.DisplayAlerts = True '確認メッセージを有効化


    End Sub

■３
更にやりたいことについては、（´・ω・`）さんのシート数を数えるに１票ですかね。
（私の場合、ずぼらなので必要なくても処理しちゃえって考えがちですけど。。。）

（もこな２） 2021/03/03(水) 18:41

「Select Case」を使うアイデアと「フラグ管理」のアイデアをミックスして１ブック内で完結するように再考してみました。参考に提示します。 
    Sub 再考バージョン()   
        Dim i As Long
        Dim フラグ As Boolean


        For i = 1 To Worksheets.Count
            Select Case Worksheets(i).Name
                Case "A", "B", "C"
                Case Else
                    フラグ = True
                    Exit For
            End Select
        Next i


        If フラグ = True Then
            Worksheets(Array("A", "B", "C")).Move before:=Worksheets(1)


            Application.DisplayAlerts = False
            For i = Worksheets.Count To 4 Step -1
                Worksheets(i).Delete
            Next i
            Application.DisplayAlerts = True
        End If


    End Sub

（もこな２ ） 2021/03/04(木) 09:48

もこな2さん、おはようございます。
再度アイディアご提示くださり有り難うございます！
初めての投稿でしたが、一夜明けて改めてご教示頂いたことに感激しております！！

MsgBoxなど追加しつつ早速試してみまして、希望通りの挙動となっていることを確認しました。
初心者ながら、こちらの構文がスッキリしていて良さそうですね。
稚拙なご質問となるかもしれませんが、またの機会がありましたら宜しくお願いいたします！
（けい） 2021/03/04(木) 10:05

 一応　コピペで動くサンプル提示しときます。
 尚　手動削除、シート名変更の対策も考慮する必要があるかもしれません。


 Sub 月次処理シート初期化()
     Dim targetSheet As Worksheet  '繰り返し用
     Dim DelChk As Integer  '削除確認用
     Dim WSc As Long '■■■■
     DelChk = MsgBox("初期化のためシートを削除します。この操作は元に戻せなくなりますが、削除してよろしいですか？", vbYesNo + vbExclamation, "注意！")
     If DelChk = vbYes Then
         Application.DisplayAlerts = False
         '削除処理
         WSc = Worksheets.Count '■■■■
         For Each targetSheet In Worksheets
             If targetSheet.Name <> "A" And targetSheet.Name <> "B" And targetSheet.Name <> "C" Then
                 targetSheet.Delete
             End If
         Next
         If WSc = Worksheets.Count Then MsgBox "削除対象シートはありません " '■■■■
         Application.DisplayAlerts = True
     Else
         MsgBox "削除処理を中止しました。"
     End If
 End Sub

（チオチモリン） 2021/03/04(木) 13:21

コメント返信：

[ 一覧(最新更新順) ]

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