エクセルVBAでワークシート削除

質問

ブックの中にある、表示されているシートで、たとえば図表1～図表4（何番まであるかは不定です）という名前のシートを削除するVBAを作りました。ただの「図表」という名前のシートや、「何々図表」、「図表集計」等のシートは削除しません。

Sub 保存図表削除()
Dim SN As String
For Each sh In Worksheets
SN = sh.Name
If sh.Visible And IsNumeric(Mid(SN, 3, Len(SN) - 2)) And Left(SN, 2) = "図表" Then
ans = MsgBox(SN & "を削除してよい？", vbYesNo)
If ans = vbYes Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
End If
Next
End Sub

これでうまく作動するのですが、いちいちシートごとに削除の有無を聞かずに、削除するシート名をまとめて表示し、それらを削除するかしないかを聞くにはどうすればよいでしょうか？
「図表1,2,3,4があります。これらを削除しますか？」というような感じです。

回答No.2

KenKen_SP · ベストアンサー

こんにちは。KenKen_SP です。

ちょっと長いかな？

Sub 保存図表削除()

　　Dim SN　　　As String
　　Dim SH　　　As Worksheet
　　Dim ans　　 As Integer
　　Dim strSH() As String
　　Dim i　　　 As Long
　　Dim strMES　As String

　　Const PREFIX As String = "図表"

　　i = 0
　　For Each SH In ThisWorkbook.Worksheets
　　　　If SH.Visible And Left$(SH.Name, 2) = PREFIX Then
　　　　　　SN = Mid$(SH.Name, 3)
　　　　　　If IsNumeric(SN) Then
　　　　　　　　ReDim Preserve strSH(i)
　　　　　　　　strSH(i) = SH.Name
　　　　　　　　strMES = strMES & SN & ","
　　　　　　　　i = i + 1
　　　　　　End If
　　　　End If
　　Next SH
　　If i > 0 Then
　　　　strMES = Left$(strMES, Len(strMES) - 1)
　　　　ans = MsgBox( _
　　　　　　　　Prompt:=PREFIX & "[ " & strMES & " ]があります。これらを削除しますか？", _
　　　　　　　　Buttons:=vbOKCancel Or vbExclamation Or vbDefaultButton2)
　　　　If ans = vbOK Then
　　　　　　Application.DisplayAlerts = False
　　　　　　　　ThisWorkbook.Sheets(strSH).Delete
　　　　　　Application.DisplayAlerts = True
　　　　End If
　　End If
　　Erase strSH

End Sub

お礼

ありがとうございました。

完璧に作動しました。
ただ、内容がまだついていけないところがあるので勉強します。

　　　　　　　　ReDim Preserve strSH(i)
　　　　　　　　strSH(i) = SH.Name

ありがとうございました。

回答No.7

Wendy02

こんばんは。Wendy02です。

#5 訂正です。

＞Sh.Name Like SH_BASENAME & "#*"
＞
＞# は必要です。　←なくても関係ありませんでした。

今回の場合は、Like演算子では、* でよかったのでした。# （数字）は、正規表現のこだわりが残っていたのが理由です。Like演算子には、前のメタキャラクタのリフレイン「＋または{n,m}」（＋ =前の文字１個以上, {n,m}前の文字n個以上、m個以下） というような書き方がないので、しょうがないですね。「*」は、正規表現のメタキャラクタとは、意味が違いますし。

If Sh.Name Like SH_BASENAME & "*" And IsNumeric(Mid$(Sh.Name, 3))
できれば、このAnd IsNumeric(Mid$(Sh.Name, 3)) は、付けたくありませんでした。

お礼

ありがとうございました。

回答No.6

imogasi

＃１です。質問の重点をつかめませんでした。すみません
データ例
図表 1
図表１２３あ 1
図表123 n
図表123a 1
図表123a12 1
図表特別 1
図表第12 1
図1表 2
12図表 2
図表0 n
図表(12)判定１３ 1
図表a 1
図表11２ n
図表１sd 1
図表02 n
図表1023003 n
1図表 2
as2図表 2
で
Sub test01()
Dim sn(100)
idx = 0
For i = 1 To 18
s = Cells(i, "A")
If Mid(s, 1, 2) = "図表" Then
s1 = Right(s, Len(s) - 2)
If IsNumeric(s1) Then
Cells(i, "B") = "n"
sn(idx) = s
idx = idx + 1
Else
Cells(i, "B") = 1
End If
Else
Cells(i, "B") = 2
End If
Next i
For j = 0 To idx - 1
MsgBox sn(j)
Next j
End Sub
を実行すると、まず良さそうなのですが、図表01２がOKになります。良いでしょうかね。

お礼

ありがとうございました。

回答No.5

Wendy02

こんにちは。

merlionXX さん、Wendy02です。

よくみると、昨日のは、ちょっと変です。今、別の仕事をした後なのか、最近、すこぶる集中力が悪いです。（^^;

＞あと、図表10とか二桁には対応していないようです。
＞（Sh.Name Like SH_BASENAME & "#" の#を*にすれば大丈夫でした）

Sh.Name Like SH_BASENAME & "#*"

# は必要です。

ですが、#* の * は、何でもありになってしまうので、その後、枝番を数字をもう一度チェックしなければなりません。

本当は、正規表現のように、「\d+」が出来ればと思いつつ間違えてしまいました。Like 演算子のメタキャラクタは、表現力が低いですね。

＞Split(Mid$(ShNames, 2), vbLf って、改行部分で分けるという意味ですか？

そうです。

＞> NumberStock という表示用の変数だけが、浮いています。
＞
＞う～みゅ、知識不足でどんな浮きぐあいなのかもわかりません。すみません。
同じ目的のものは、再利用する、というのが原則なんですね。だから、NumberStock で、表示用だけに、番号だけを集めるのはナンセンスなのです。（←ここら辺は、ピンボケしていても、ヘンだということぐらいは、私はまだ分るようです。（^^;）

夕べ、眠る前に、頭の中で考えたのは、以下のとおりです。一番、気になったのは、プロシージャ名だったりして。Special は間違いで　Specified でした。直接、関係ないけれどね。プロシージャ名を英語化するっていうのも、一応、原則です。

Sub SpecifiedSheetsDelete() '←名前を変えた
Dim Sh As Worksheet
Dim ShNames As String　'←変数　NumberStockをやめた
Const SH_BASENAME As String = "図表"

For Each Sh In ThisWorkbook.Sheets
　If Sh.Visible = xlSheetVisible Then
　'# → #* に変更した
　If Sh.Name Like SH_BASENAME & "#*" And IsNumeric(Mid$(Sh.Name, 3)) Then
　　 ShNames = ShNames & "," & Sh.Name
　End If
　End If
Next Sh
　ShNames = Mid$(ShNames, 2)　'←ここで、調整することにした。
　If Len(ShNames) < 2 Then MsgBox "削除すべきシートはありません。", vbInformation: Exit Sub
　If MsgBox(SH_BASENAME & " " & Replace(ShNames, SH_BASENAME, "") & " があります。これらを削除しますか？", 33) = vbOK Then
　　Application.DisplayAlerts = False
　　 ThisWorkbook.Sheets(Split(ShNames, ",")).Delete
　　Application.DisplayAlerts = True
　End If
End Sub

これをみれば、私が何にこだわっているか、なんとなく分っていただけるかしら。

お礼

ありがとうございました。

回答No.4

Wendy02

こんばんは。
私も、ちょっと考えてみました。

要望だからしかたがないけれど、NumberStock という表示用の変数だけが、浮いています。それぞれのコードを研究してみてください。ある程度の原則的なルールに基づいて書いているつもりなのですが、それがアダにならないとも限りませんので、「自信なし」です。

MsgBox のところの　33だけは、長くなりすぎると思い、割愛して足し算してしまいました。vbQuestion + vbOkCancel =33 です。

Sub SpecialSheetDelete()
Dim Sh As Worksheet
Dim ShNames As String
Dim NumberStock As String
Const SH_BASENAME As String = "図表"

For Each Sh In ThisWorkbook.Sheets
　If Sh.Visible = xlSheetVisible Then
　If Sh.Name Like SH_BASENAME & "#" And IsNumeric(Mid$(Sh.Name, 3)) Then
　　 '表示用の枝番ストック
　　 NumberStock = NumberStock & "," & Mid$(Sh.Name, 3)
　　 ShNames = ShNames & vbLf & Sh.Name
　End If
　End If
Next Sh

　If Len(ShNames) < 2 Then MsgBox "削除すべきシートはありません。", vbInformation: Exit Sub
　If MsgBox(SH_BASENAME & " " & Mid$(NumberStock, 2) & " があります。これらを削除しますか？", 33) = vbOK Then
　　Application.DisplayAlerts = False
　　 ThisWorkbook.Sheets(Split(Mid$(ShNames, 2), vbLf)).Delete
　　Application.DisplayAlerts = True
　End If
End Sub

お礼

ありがとうございます。

> NumberStock という表示用の変数だけが、浮いています。

う～みゅ、知識不足でどんな浮きぐあいなのかもわかりません。すみません。

あと、図表10とか二桁には対応していないようです。
（Sh.Name Like SH_BASENAME & "#" の#を*にすれば大丈夫でした）

Split(Mid$(ShNames, 2), vbLf って、改行部分で分けるという意味ですか？

ありがとうございました。

回答No.3

BLUEPIXY

Dim SN As String, sh As Worksheet, ans
Dim DelList As String, Num As String, x

DelList = ""
For Each sh In Worksheets
SN = sh.Name
Num = Mid(SN, 3, Len(SN) - 2)
If sh.Visible And IsNumeric(Num) And Left(SN, 2) = "図表" Then
DelList = DelList & Num & ","
End If
Next
If DelList <> "" Then
DelList = Left(DelList, Len(DelList) - 1)
ans = MsgBox("図表" & DelList & "を削除してよい？", vbYesNo)
If ans = vbYes Then
Application.DisplayAlerts = False
For Each x In Split(DelList, ",")
Sheets("図表" & x).Delete
Next
Application.DisplayAlerts = True
End If
End If
End Sub

お礼

完璧に作動しました。

コードも理解できました。
ありがとうございました。

回答No.1

imogasi

Sub test01()
s = Array("Sheet2", "Sheet3", "Sheet4")
y = InputBox(s(0) & Chr(10) & s(1) & Chr(10) & s(2) & Chr(10) & "を削除しますか")
If y = "y" Then
For i = 0 To UBound(s)
Worksheets(s(i)).Delete
Next i
End If
End Sub
削除確認が出ますが、必要なければ
DisplayAlerts=Falseを入れる。

お礼

ありがとうございます。

ただ、Array("Sheet2", "Sheet3", "Sheet4")の中にどうやって対象シート名を入れるかがわからなかったのです・・・・・。