Excelで、複数ブックの複数シートを削除するマクロを教えて下さい

Question

Excelで、複数ブックの複数シートを、ブック名、シート名を指定して削除するマクロを教えて頂けないでしょうか？対象のブックは複数あり、ひとつづつシートの削除処理をするところを自動化したいと思っています。宜しくお願い致します。

tatsu99 · Accepted Answer

No10です。
標準モジュールに以下のマクロを登録してください。
A列2行以降がブック名
B列2行以降が削除シート名
C列2行以降がブックが格納してあるフォルダ名
D列2行以降が削除結果
になります。添付資料参照。
このシート名は”管理シート”になります。
黄色部分がマクロ実行前にあなたが設定する箇所です。
拡張子は、xlsx,xlsmのみ有効です。
------------------------------------------------------
Option Explicit

Public Sub 指定シート削除()
    Dim sh As Worksheet
    Dim exec_count As Long
    Dim maxrow As String
    Dim result As Boolean
    If MsgBox("各ブックのシートを削除します", vbOKCancel) = vbCancel Then Exit Sub
    Dim row As Long
    Set sh = Worksheets("管理シート")
    maxrow = sh.Cells(Rows.count, 1).End(xlUp).row    'sheetの最大行取得
    exec_count = 0
    Application.ScreenUpdating = False
    For row = 2 To maxrow
        result = Sakujo(row, sh)
        ThisWorkbook.Activate
        If result = True Then
            sh.Cells(row, "D").Value = "削除成功"
            exec_count = exec_count + 1
        Else
            sh.Cells(row, "D").Value = "削除失敗"
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox ("削除処理完了　処理件数=" & exec_count)
End Sub

'削除処理
Private Function Sakujo(ByVal row As Long, ByVal sh As Worksheet) As Boolean
    Dim bookName As String  '分散ブック名
    Dim sheetName As String '分散シート名
    Dim bookpath As String  '分散ブック名（完全パス）
    Dim bookfolder As String  '分散ブック格納フォルダ名
    Sakujo = False
    ThisWorkbook.Activate
    bookName = sh.Cells(row, "A").Value
    sheetName = sh.Cells(row, "B").Value
    bookfolder = sh.Cells(row, "C").Value
    If CheckBookName(bookName) = False Then
        MsgBox (bookName & "はサポートしません。")
        Exit Function
    End If
    If dir(bookfolder, vbDirectory) = "" Then
        MsgBox ("フォルダ名=" & bookfolder & "は存在しません。")
        Exit Function
    End If
    bookpath = bookfolder & "\" & bookName
    If dir(bookpath) = "" Then
        MsgBox ("ブック名=" & bookpath & "は存在しません。")
        Exit Function
    End If
    Workbooks.Open bookpath
    Workbooks(bookName).Activate
    If ExistsWorkSheet(sheetName) = False Then
        MsgBox (bookName & "中に" & sheetName & "は存在しません")
        Workbooks(bookName).Close SaveChanges:=False
        Exit Function
    End If
    If Worksheets.count = 1 Then
        MsgBox (bookName & "中の" & sheetName & "は１つのシートしかないので削除できません")
        Workbooks(bookName).Close SaveChanges:=False
        Exit Function
    End If
    Application.DisplayAlerts = False
    Worksheets(sheetName).Delete
    Application.DisplayAlerts = True
    Workbooks(bookName).Close SaveChanges:=True
    Sakujo = True
End Function

'ブック名のチェック
Public Function CheckBookName(ByVal bname As String) As Boolean
    CheckBookName = False
    '拡張子を取得
    Dim pos As Variant
    Dim ext  As String
    pos = InStrRev(bname, ".")
    If pos > 0 Then
        ext = UCase(Right(bname, Len(bname) - pos))
        If ext = "XLSX" Or ext = "XLSM" Then
            CheckBookName = True
        End If
    End If
End Function
'ワークシートの存在チェック
Public Function ExistsWorkSheet(ByVal sheetName As String) As Boolean
    Dim ws As Worksheet
    ExistsWorkSheet = False
    For Each ws In Worksheets
        If UCase(ws.Name) = UCase(sheetName) Then
            ExistsWorkSheet = True
            Exit Function
        End If
    Next ws
End Function
-------------------------------------------------------

tatsu99 · Answer

>例えば、マクロ管理シートなるものを作成しＡ列に対象ブック名、Ｂ列に削除したい対象シート名を入力し
ということですが、対象となるブックは、一か所のフォルダに格納されているのですか、それとも、ばらばらですか。もし、ばらばらなら、C列に格納フォルダの指定が必要です。もし、一か所なら、1行目のどこかに
その格納フォルダを記述し、2行目が見出し、３行目からデータ（A列ブック名　B列シート名）にすればよいかと。

又、あなたのパソコンは拡張子を常時表示していますか。もし、拡張子を表示しないと、ブックの正しい名称が判らなくなります。
book1.xls
book1.xlsm
book1.xlsx
これは、全てbook1ですが異なるものです。
拡張子を表示するようにしてください。その方法が判らない場合は、補足ください。
"拡張子 表示"で検索すれば、いろいろ出てきます。
削除するブック名は、拡張子を含めて指定するようにします。
例　book1ではなくbook1.xlsxと指定します。
拡張子を含めて指定する場合、今でも、xlsを使用していますか。
通常は、xlsは使用しないので、拡張子は、xlsxとxlsmのみOKとしたほうが安全です。

tom04 · Answer

No.６です。

＞「保存場所のパス」は実際の保存場所のパス』とありますが、このマクロを格納しているエクセルの保存場所のことでしょうか？

特定のフォルダにファイルをまとめるのが一般的だと思います。
パスの確認方法として、保存場所のフォルダを開く　→　その中のどのファイル（ブック）でもよいのでファイルのアイコン上で右クリック　→　プロパティ
「ファイル」のプロパティダイアログボックスが表示されます。
「場所」の部分が保存場所のパスになりますので、
それをそのまま前回のコード内の「保存場所のパス」の部分にコピー＆ペーストすれば大丈夫です。

※　コード記載のExcelファイルと対象ファイルが同じフォルダ内に保存してある場合は
＞myPath = "保存場所のパス" & "\"
を
＞myPath = ThisWorkbook.Path & "\"
としても大丈夫です。m(_ _)m

yokomaya · Answer

念のため付け加えますがトータルたったの４行ですよ。
これを自分ではやりたくないって、
そんなにまで頑ななら、
人に聞いてまですることないと思いますが。

無茶でしょうか？

それと用語ね、判りにくいこと多数あると思います。
短い文章で三つ知らない言葉出てきたら僕も嫌です。
読む気力萎えます。

そこは、わかるんですけど、コードだけは自分で試して欲しいなぁ。

それが理解できるかどうかは、これからのあなたの努力次第
でしょうけど。

結論を急がずにぼちぼち試してもらえたら、
今は理解できなくても、
続けてさえいれば他のテーマも色々とチャレンジしてれば
半年か一年後には或いは３年後、ぼんやりと見えてくるんじゃないかな。

理解するって、そんなスパンで考えるものだと思います。

yokomaya · Answer

みっつも下ですよ。
こちらはお爺さんだな。

＞「Workbooks("Honyaraka.xlsx").Sheets("Sheet3").Delete」ではどのようなＶＢＡを記述すれば良いのでしょうか？？

と訊かれたので、そこを----に当てはめて
"Honyaraka.xlsx"→rg.text
"Sheet3"→rg.offset(0,1).text
とするだけですよ。

ほぼ答えそのものなんだけど。

勿論、一朝一夕に意味が判ったら、逆に空恐ろしいし
（こっちはどんなにかかってるか・・・。）

ただ、自分で触ってみなきゃ、どんなに人のを見ても訊いても
身に付かないことを、知っているので。

是非ぶつかって乗り越える努力を期待したいです。

tom04 · Answer

こんばんは！

すでに回答は出ているので参考程度で・・・

マクロのコードを記載するブックのSheet1に↓の画像のような配置で
A列にファイル名、B列に削除するシート名を羅列しているとします。
ファイルはExcel2007以降としています。（拡張子を .xlsx　としている）

標準モジュールです。

Sub Sample1()
    Dim i As Long, j As Long, k As Long, wB As Workbook
    Dim myPath As String, fN As String, sN As String
        myPath = "保存場所のパス" & "\"    '//★//
        Application.ScreenUpdating = False
            With ThisWorkbook.Worksheets("Sheet1")
                For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
                    fN = .Cells(i, "A") & ".xlsx"
                    If Dir(myPath & fN) <> "" Then
                        Workbooks.Open myPath & fN
                        Set wB = ActiveWorkbook
                            For j = 2 To .Cells(Rows.Count, "B").End(xlUp).Row
                            For k = wB.Worksheets.Count To 1 Step -1
                                sN = .Cells(j, "B")
                                If wB.Worksheets(k).Name = sN Then
                                    Application.DisplayAlerts = False
                                        If wB.Worksheets.Count = 1 Then
                                            Worksheets.Add after:=wB.Worksheets(1)
                                        End If
                                        wB.Worksheets(k).Delete
                                    Application.DisplayAlerts = True
                                End If
                            Next k
                            Next j
                            wB.Close savechanges:=True
                    End If
                Next i
            End With
        Application.ScreenUpdating = True
            MsgBox "完了"
End Sub

※　コード内の「★」の行　「保存場所のパス」は実際の保存場所のパスにしてください。

※　すべてのシート名が存在する場合、最低限1シートは必要なので
その辺の処理も考慮してみました。
（B列のシート名は削除されます）m(_ _)m

TH69 · Answer

FileSystemObject勉強中なので、それを使って考えてみました。不必要なら読み飛ばして下さい。

結構長くなりました（汗）
ブック名とシート名が入力されているシートがアクティブであるとしています。
またシート名はA列のブックに対し複数のシートがある場合はB列、C列・・・と記入するものとします。
マクロを記入するブックとシートを削除するブックは同じフォルダにあるものとします。

ws=アクティブシートとし
a=wsのA列最終行番号
myPath=アクティブブックのパスとします。
iのループでwsの2行目からa行目まで
b=wsのi行A列の値（ブック名）
c=wsのi行最終列番号とし、
条件分岐で、cが1以上なら（シート名記入あり）
条件分岐で、FSOでbのブックが存在するかどうか調べ
存在したらブックbを開き、
jのループで2列目からc列目まで
d=wsのi行j列の値（シート名）とし、
エラーがでたら次へ進み、警告を表示しない設定で、
ブックbのシートdを削除します。
次のjをループします。
エラーの場合は（多分当該シートが見つからないなので）
「シートdが見つかりません」と表示します。
jのループが終了したら、次のiをループします。

Sub test()
    Dim a, b, c, d, i As Long, j As Long, ws As Worksheet
    Dim myPath As String, myFile As Object
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ws = ActiveSheet
    a = ws.Cells(Rows.Count, "A").End(xlUp).Row
    myPath = ThisWorkbook.Path & "\"
    For i = 2 To a
        b = ws.Cells(i, "A").Value
        c = ws.Cells(i, Columns.Count).End(xlToLeft).Column
        If c > 1 Then
            If FSO.FileExists(myPath & b) = True Then
                Workbooks.Open FSO.GetFile(myPath & b), ReadOnly:=False
                For j = 2 To c
                    d = ws.Cells(i, j).Value
                    On Error Resume Next
                    Application.DisplayAlerts = False
                    ActiveWorkbook.Worksheets(d).Delete
                    Application.DisplayAlerts = True
                    If Err.Number <> 0 Then
                        MsgBox "シート「" & d & "」が見つかりません", vbExclamation
                        On Error GoTo 0
                    End If
                Next j
                ActiveWorkbook.Close SaveChanges:=True
            Else
                MsgBox "ブック「" & b & "」が見つかりません", vbExclamation
            End If
        End If
    Next i
End Sub

私からもヒントを…。
VBEの画面にローカルウインドウを表示させF8キーでステップ実行すると、どの変数に何の値が格納されているのかなどが分かり、とても参考になります。yokomaya 様のブレークポイントとともに、マクロの動作確認をしながら勉強されることをお勧めします。

yokomaya · Answer

ヒントを追加しておきます。

一気にdeleteに進むのではなく
一旦
msgbox rg.text & ":" & rg.offset(0,1).text
としてみると、どんな文字列が双方に表示されているかを
確認することが出来ます。

また、コードの左側に幅数ｍｍの帯状の部分ありますよね。
ここをクリックすると茶色の丸が付いて
実行するとそこの行を実行直前で強制中断されます。

この丸を付ける操作をブレークポイントを設定するといいます。

for each の行にブレークポイントを設定して中断したら
イミディエイトウィンドウに

? worksheets("マクロ管理シート").usedrange.address
? worksheets("マクロ管理シート").usedrange.columns(1).address
? worksheets("マクロ管理シート").usedrange.columns(1).cells.address
と、それぞれ入力してみて、セル番地がどうなっているかを
確かめると、一気に理解しやすくなります。

このブレークポイントを設定して、途中で値を確認することは
マクロを身に着けるうえで、とても大事なので
説明しておきたいと思いました。

yokomaya · Answer

＞知識がないので
誰でも最初は知識などありません。
問題は知識を身に着けていくおつもりか、そうでないのかです。

ＥＸＣＥＬのＶＢＡにおいてセルの処理をスキップして出来ることって
どれくらいあるでしょう？

最初にマスターすべきことのひとつではないでしょうか？

私の記述は
dim rg as range
for each rg in worksheets("マクロ管理シート").usedrange.columns(1).cells
--------------------------------------------
next

で-----の部分に
rg.textとrg.offset(0,1).textを使って
与えるものです。

あえてコピペできる形をとらないのは
考えてほしいからです。
マクロは訊いただけでは絶対に身に付きません。
自ら書いて乗り越えていく、達成感なくして
続くものでもないです。

健闘を祈ります。

yokomaya · Answer

削除自体はとても簡単ですし、マクロ記録すれば誰でも
 Sheets("Sheet3").Select
 ActiveWindow.SelectedSheets.Delete
こんなコードが得られます。
実はマウス操作するのでselectが入ってしまいますが
Sheets("Sheet3").Delete
で十分です。
これはこのブックなので前に何もつきませんが
他のブックの場合なら
Workbooks("Honyaraka.xlsx").Sheets("Sheet3").Delete
の様な感じです。
セルにリストを準備しておけば、ここでは直接文字列を
与えている部分にセルの文字列を.Textプロパティで
渡すこともできますから、リストをシート上に作れば
ループでいくらでも消せます。
問題はブックやシートの規則性というか、どういう風に選ぶのかを
あなたがコーディングできるかどうかではないかと。

Excelで、複数ブックの複数シートを削除するマクロを教えて下さい

No10です。

>例えば、マクロ管理シートなるものを作成しＡ列に対象ブック名、Ｂ列に削除したい対象シート名を入力し

No.６です。

念のため付け加えますがトータルたったの４行ですよ。

みっつも下ですよ。

こんばんは！

FileSystemObject勉強中なので、それを使って考えてみました。

ヒントを追加しておきます。

＞知識がないので

削除自体はとても簡単ですし、マクロ記録すれば誰でも

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング