選択シート以外のシートを削除する【ExcelVBA】

何十シートもあるExcelファイルをつくるなよ
重いんだよ

しかもマスターブックから項目ごとに抜粋するとか。。。

など不満はありますが、使わざるを得ないのでせめてその単純作業をラクにしたくて即興で作りました。

最近ようやく捨てマクロ的な手軽さで書けるようになってきました。

使い方

1. Ctrl＋クリックで残したいシートを選択する
2. マクロ選択シート以外を削除を実行する

コード

Option Explicit

Sub 選択シート以外を削除()
  Dim wb As Workbook
  Dim ws As Worksheet
  Set wb = ActiveWorkbook
  Dim ws選択中 As Sheets
  Set ws選択中 = ActiveWindow.SelectedSheets
  
  Dim myList
  Set myList = Get重複無しリスト_ws(ws選択中)
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  For Each ws In wb.Sheets
    If Not myList.Exists(ws.Name) Then
        ws.Delete
    End If
  Next
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Private Function Get重複無しリスト_ws(ws対象 As Sheets)
    Dim Dic, i As Long, myKey As String, myColorIndex As Long
    Set Dic = CreateObject("Scripting.Dictionary")
    
    myColorIndex = 0
    Dim ws As Worksheet
    For Each ws In ws対象
        myKey = ws.Name
        If Not Dic.Exists(myKey) Then
            Dic.Add myKey, myKey
        End If
    Next
    Set Get重複無しリスト_ws = Dic
End Function

振り返り・新しく知ったこと

選択中のシートを指すメソッドはActiveWindow.SelectedSheets

Dim ws選択中 As Sheets
Set ws選択中 = ActiveWindow.SelectedSheets

でSetしておいて

Set myList = Get重複無しリスト_ws(ws選択中)

といった感じで変数に投げ込めば普通にSheetオブジェクト群としてループを回せる。

重複処理をする必要はないが、他で使ったリストアップ系自作関数の使い回しでいけたのでとりあえず流用している感じ。

重複無しリストアップ関数は入れるものの型別にシリーズ展開して自分ライブラリに登録しておいてもいいかも。