[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『特定のシートの存在有無での構文の書き方について』(けい)
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
投稿後、自分なりに調べたり色々考えてみまして・・・
ブール型変数というのでしょうか、以下の通りの構文に書き換えてみました。
こちらで試してみたところ、先ずはやりたいことが実現できているように見受けられます。
(何らかの落ち度がありましたら、ご指摘頂ければ幸いです)
皆様にご教示頂いた構文もどれも興味深いです。
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
■1
既に関連コメントがありますが、今回のケースでいえば「Application.DisplayAlerts」はループの外のほうがよいでしょう。
■2
必要なものを"残す"という考え方を変えて、全部消してから必要なものを"戻す"とすればこんな方法もありますね。
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
■3
更にやりたいことについては、(´・ω・`)さんのシート数を数えるに1票ですかね。
(私の場合、ずぼらなので必要なくても処理しちゃえって考えがちですけど。。。)
(もこな2) 2021/03/03(水) 18:41
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
(もこな2 ) 2021/03/04(木) 09:48
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.