• ベストアンサー

インプットボックスについて

指定したシートを削除するマクロを作っています。1つのシートを指定して削除するマクロはできたのですが、複数のシートを指定して削除するにはどうすればいいか分からなくて困っています。教えて下さい。 Sub 指定して削除() Application.DisplayAlerts = False Sheet = InputBox("削除したいシート名を入力して下さい。") Worksheets(Sheet).Delete Application.DisplayAlerts = True End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.7

こんばんは。 実際に立ち上げると、入力例が出ますが、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

noa8998
質問者

お礼

いつもありがとうございます。 こんな高度なマクロどう考えてもわかりませんでした。 本当にありがとうございます。

その他の回答 (7)

  • Alpha-j
  • ベストアンサー率66% (18/27)
回答No.8

思い切って 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

noa8998
質問者

お礼

こういうやり方もあるんですね。すごく勉強になりました。ありがとうございました。

  • Alpha-j
  • ベストアンサー率66% (18/27)
回答No.6

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)
回答No.5

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)
回答No.4

>削除するシートが多いのですが、印刷するときのように「1-10」というような入力の仕方で一度で1~10のシートを >削除というようにできないでしょうか? シート名とシートの配列がどのようになっているのかわかりませんが、 削除したいシートタブをCtrlキーを押しながら左クリックしていき、 右クリックの削除ではダメなのですか? 「1-10」がシート名を示すのか左からの順番を示すのかにもよりますけど。

noa8998
質問者

補足

1、10は実際のシート名です。 >削除したいシートタブをCtrlキーを押しながら左クリックしていき、 右クリックの削除ではダメなのですか? この操作ができない人もいるので、マクロでできないかなぁと思いまして・・・

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.3

ANo.2です。 ちょっとミスりました。 v = Application.InputBox("削除したいシート名を[,、]で区切って入力して下さい", 2) を v = Application.InputBox("削除したいシート名を[,、]で区切って入力して下さい", Type:=2) に置き換えて下さい。

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.2

都度確認しなくても良ければ、 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 ご参考程度に。

noa8998
質問者

お礼

削除枚数が少ないものに使わせていただきます。ありがとうございました。

noa8998
質問者

補足

削除するシートが多いのですが、印刷するときのように「1-10」というような入力の仕方で一度で1~10のシートを削除というようにできないでしょうか?

  • Alpha-j
  • ベストアンサー率66% (18/27)
回答No.1

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

noa8998
質問者

補足

削除するシートが多いのですが、印刷するときのように「1-10」というような入力の仕方で一度で1~10のシートを削除というようにできないでしょうか?

関連するQ&A

専門家に質問してみよう