- ベストアンサー
インプットボックスについて
指定したシートを削除するマクロを作っています。1つのシートを指定して削除するマクロはできたのですが、複数のシートを指定して削除するにはどうすればいいか分からなくて困っています。教えて下さい。 Sub 指定して削除() Application.DisplayAlerts = False Sheet = InputBox("削除したいシート名を入力して下さい。") Worksheets(Sheet).Delete Application.DisplayAlerts = True End Sub
- みんなの回答 (8)
- 専門家の回答
質問者が選んだベストアンサー
こんばんは。 実際に立ち上げると、入力例が出ますが、1-10 は、1~10まで、5,6 は、5と6のシート 2,5-10 は、2と5~10 です。 最後に、削除してよいかたずねてきますから、一度、確認してから削除してください。 現行のマクロでは、シート名は、数字型に限ります。 必ず、「標準モジュール」に入れてください。シートモジュールには入れないでください。 ----------------------------------------------------- Sub SheetDeleMac() Dim ret As Variant ret = Application.InputBox("シート名の範囲を入れてください。" & vbCrLf & _ "入力例:1-10 または、5,6 または、2,5-10", "シート削除", Type:=2) If VarType(ret) = vbBoolean Or ret = "" Then Exit Sub '区切り文字の半角統一 ret = Replace(ret, "-", "-", , , 1) ret = Replace(ret, ",", ",", , , 1) If InputSplit(ret) = False Then MsgBox "すべてのシートを削除することは出来ません。", vbCritical ActiveSheet.Select Exit Sub End If If MsgBox("選択したシートを削除してよいですか?", vbOKCancel + vbDefaultButton2) = vbOK Then Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True Else ActiveSheet.Select End If End Sub Function InputSplit(mStr As Variant) Dim ar As Variant Dim ar2() As Variant Dim ar3() As Variant Dim i As Integer Dim j As Integer Dim v As Variant Dim n As Variant Dim m As Integer Dim sh As Variant Dim tmp As Variant Dim flg As Boolean flg = True ActiveWorkbook.ActiveSheet.Select 'カンマで切る ar = Split(mStr, ",") For Each v In ar If InStr(v, "-") > 0 Then For Each n In Split(v, "-") ReDim Preserve ar2(i) ar2(i) = n i = i + 1 Next Else ReDim Preserve ar3(j) ar3(j) = v j = j + 1 End If Next v If UBound(ar2) = 1 Then If Val(ar2(0)) > Val(ar2(1)) Then tmp = ar2(0) tmp = ar2(0): ar2(0) = ar2(1): ar2(1) = tmp End If ReDim ar(ar2(1) - 1) For i = Val(ar2(0)) To Val(ar2(1)) ar(m) = i m = m + 1 Next i End If On Error Resume Next For Each sh In ar ActiveWorkbook.Worksheets(sh).Select flg flg = False Next For Each sh In ar3 ActiveWorkbook.Worksheets(sh).Select flg flg = False Next If ActiveWindow.SelectedSheets.Count = ActiveWorkbook.Worksheets.Count Then InputSplit = False Else InputSplit = True End If On Error GoTo 0 End Function
その他の回答 (7)
- Alpha-j
- ベストアンサー率66% (18/27)
思い切って This Workbook に以下のコマンドを実装し、削除したいシートのどこかを2回ダブルクリックすると削除できるようにするのはいかがでしょうか Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete End Sub
お礼
こういうやり方もあるんですね。すごく勉強になりました。ありがとうございました。
- Alpha-j
- ベストアンサー率66% (18/27)
ANo.5は誤りでした。テスト済みコードを以下に載せます 1. ThisWorkBook に以下を挿入 Private Sub Workbook_Open() MsgBox ("Ctrlを押しながらクリックして削除するシートを選んでください" & vbCrLf & "選択が終わったらCtrl+Alt+D を押すと選択したシートが削除されます。") Application.OnKey "^%d", "DelSheets" Application.OnKey "^%D", "DelSheets" End Sub 2. Module1 として以下を記述 Sub DelSheets() Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete End Sub でいかがでしょうか? シート名をいちいち入力するのはチョット面倒ですので
- Alpha-j
- ベストアンサー率66% (18/27)
Sub Macro1() Application.DisplayAlerts = False Ans = MsgBox("削除するシートをCtrlを押しながらクリックしてください" & crlf & "選択が完了したらOKを押してください", vbOKOnly) If Ans = vbOK Then ActiveWindow.SelectedSheets.Delete End If End Sub
- n-jun
- ベストアンサー率33% (959/2873)
>削除するシートが多いのですが、印刷するときのように「1-10」というような入力の仕方で一度で1~10のシートを >削除というようにできないでしょうか? シート名とシートの配列がどのようになっているのかわかりませんが、 削除したいシートタブをCtrlキーを押しながら左クリックしていき、 右クリックの削除ではダメなのですか? 「1-10」がシート名を示すのか左からの順番を示すのかにもよりますけど。
補足
1、10は実際のシート名です。 >削除したいシートタブをCtrlキーを押しながら左クリックしていき、 右クリックの削除ではダメなのですか? この操作ができない人もいるので、マクロでできないかなぁと思いまして・・・
- n-jun
- ベストアンサー率33% (959/2873)
ANo.2です。 ちょっとミスりました。 v = Application.InputBox("削除したいシート名を[,、]で区切って入力して下さい", 2) を v = Application.InputBox("削除したいシート名を[,、]で区切って入力して下さい", Type:=2) に置き換えて下さい。
- n-jun
- ベストアンサー率33% (959/2873)
都度確認しなくても良ければ、 Sub test() Dim ws As Worksheet Dim i As Integer Dim v, vv v = Application.InputBox("削除したいシート名を[,、]で区切って入力して下さい", 2) If v = False Then Exit Sub vv = Split(Replace(v, "、", ","), ",") Application.DisplayAlerts = False For i = 0 To UBound(vv) Worksheets(vv(i)).Delete Next Application.DisplayAlerts = True End Sub ご参考程度に。
お礼
削除枚数が少ないものに使わせていただきます。ありがとうございました。
補足
削除するシートが多いのですが、印刷するときのように「1-10」というような入力の仕方で一度で1~10のシートを削除というようにできないでしょうか?
- Alpha-j
- ベストアンサー率66% (18/27)
Sub 確認しながら削除() Application.DisplayAlerts = False For i=1 to worksheets.count If i > Worksheets.Count then Exit Sub Sheet_Name=Worksheets(i).name Ans=Msgbox("シート" & Sheet_Name & "を削除しまか?",vbYesNo) If Ans=vbYes then Worksheets(i).delete Next i End Sub
補足
削除するシートが多いのですが、印刷するときのように「1-10」というような入力の仕方で一度で1~10のシートを削除というようにできないでしょうか?
お礼
いつもありがとうございます。 こんな高度なマクロどう考えてもわかりませんでした。 本当にありがとうございます。