Excelの非表示シートをVBAで削除する【実務で活用できる】

スポンサーリンク

Excelワークブックは、新規で一から作っていくと大変なので、過去に使っていたものや誰かが作ったものを流用するケースが多いと思います
しかし、このようにファイルを使いまわしていたり、複数の人が編集を加えている状況の場合、知らないうちに不要なシートが隠れていたりすることが往々にしてあると思います。私は今までに何度も出くわしています(-_-;)

その結果、ファイルサイズが肥大化してしまい、最悪の場合「Excelが開かない!」「作業中に固まった!」「データが保存できない!」「データが破損!」等々、ファイルが重いために作業効率が大幅に下がたりしなど悲しい経験をした方も多いのではないでしょうか

今までの経験を思い返してみると次のような原因が代表的なものだと思います

使っていない不要な「非表示シート」がある
・隠れて見えない不要な「オブジェクト」がたくさん残っている
・過去に編集したセルの状態「書式設定」が残っている
・手動では消せないほど大量の使っていない「名前定義」がある

今回は、この原因の一つである「非表示シート」の削除方法を紹介したいと思います

この記事は「非表示シートをVBAで効率的に削除する方法」について解説していきます

スポンサーリンク

非表示シートの削除方法(手動編)

・手動で削除する方法(ちょっと見にくいかもしれません(^^;)

(1)シートの最下部にあるタブを
 右クリック

(2)「再表示」から非表示となって
 いるシートを選択し再表示させる

(3)不要なシートタブを選択し 
 右クリックで「削除」を選択

・結構手間かかってますよねぇ

VBAを使った非表示シートの削除方法

一応ロジックをフローチャートで確認しておきます

・このフローは「フォルダ指定」と「ファイル選択指定」の両方をまとめて表示しています
・それぞれファイル操作の細かい動作に相違点があります(このあと解説します)

動作させるための設定シートを用意します

・「A2セル」にフォルダパスを表示します
・「A4セル」以下に処理したファイル名を表示します
・「B4セル」以下にファイル毎の削除したシート数を表示します
「C3セル」に「1」が入力されていればファイルの更新日時を変更しません
・「D12~D14」は非表示シートでも削除したくないシート名を入力しておきます
・実行は二つのボタンのどちらかを押下してください
こんな感じです(^^)

非表示シートを削除するコード(部分)

For Each sh In .Worksheets '非表示シートを削除
    If sh.Visible = xlSheetHidden Then
      Select Case sh.Name '除外シートを確認
           Case jyogai(0), jyogai(1), jyogai(2)
           Case Else: sh.Delete: n = n + 1 '削除
       End Select
    End If
Next For

sh.Visible = xlSheetHidden で非表示かどうかを判定しています
・Select Case sh.Name  で除外シートを確認するために動作を分岐しています
・Case Else: sh.Delete ここで非表示シートを削除しています
削除自体はこのたった一行です(^^♪

ファイル名を一括変更するコード

・それでは、VBAコードを紹介します
・二つともほとんど同じように見えますが微妙に違っています
・ファイル選択で選択したファイルは配列でフォルダ内ファイルはオブジェクトです
・なので同じ動作をさせるためにオブジェクトに変換させる作業を入れています
・②のコードの45行目「fn = fso.GetFilename(f) ‘ファイル名セット」など
・これでファイルオブジェクトに変換しています
・「f」からファイル名だけ抜き取ったのでは動作しない部分があるためです

①フォルダ内ブックの非表示シートを一括削除するコード

'フォルダ内ファイルの非表示シートを削除(日時変更なし)
Sub フォルダ内全ブック設定()
    Dim strfld As Variant
    'フォルダとファイル名消去
   Cells(2, 1) = "" 'フォルダ消去
    Range(Cells(4, 1), Cells(4, 2).End(xlDown)) = ""
    'フォルダ選択ダイアログ表示
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            strfld = .SelectedItems(1) ' & "\"
            Cells(2, 1) = strfld
        Else: MsgBox ("処理を中止します!"): Exit Sub
        End If
    End With

    Dim f As Variant    'ファイル用
    Dim d As Date       '更新日時保存用
    Dim sh As Worksheet 'ワークシート用
    Dim n As Long, i As Long 'カウンター用
    Dim jyogai(2) As String '除外シート名保存用
    For i = 0 To 2
        jyogai(i) = Cells(i + 12, 4)
    Next
    'チラつきをなくすためExcelインスタンスで対応
    Dim tgwb As Object
    Dim owb As Excel.Workbooks
    Dim oxl As Excel.Application
    Dim objShell As Object
    Dim objFld As Object
    Dim objFile As Object
    Dim pw As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    pw = Cells(4, 5)
    i = 4   '4行目から開始なので
    'フォルダ内のファイル数分のループ処理
    For Each f In fso.getFOLDER(strfld).Files
        Cells(i, 1) = f.Name    'ファイル名をセルに書き出す
        d = f.DateLastModified  ' 更新日時を取得
        
        Set oxl = CreateObject("Excel.Application")
        Set owb = oxl.Application.Workbooks
        If GetInputState() Then DoEvents '重いファイル用対策
        'ファイルを開く
        Set tgwb = owb.Open(fileName:=f, UpdateLinks:=0, Password:=pw)
        '開いたブックに対する処理
        With tgwb
            '共有の場合解除
            If .MultiUserEditing = True Then
                .UnprotectSharing
                .ExclusiveAccess
            End If
            n = 0   '削除数カウント初期化
            For Each sh In .Worksheets '非表示シートを削除
                If sh.Visible = xlSheetHidden Then
                    Select Case sh.Name '除外シートを確認
                        Case jyogai(0), jyogai(1), jyogai(2)
                        Case Else: sh.Delete: n = n + 1 '削除
                    End Select
                End If
            Next sh
        End With
        If GetInputState() Then DoEvents
        'ファイルを閉じる
        tgwb.Close (True)
        'オブジェクト初期化
        Set tgwb = Nothing
        Set owb = Nothing
        Set oxl = Nothing
        
        Cells(i, 2) = n '削除したシート数
        i = i + 1 'インクリメント
        'ここから更新日時を戻す処理(不要の場合はパス)
        If Cells(3, 3) = 1 Then
            Set objShell = CreateObject("Shell.Application") 'インスタンス化
            Set objFld = objShell.Namespace(strfld) 'フォルダを取得
            Set objFile = objFld.ParseName(f.Name) 'ファイルを取得
            '更新日時を元に戻す
            objFile.ModifyDate = d
            'オブジェクト初期化
            Set objFile = Nothing
            Set objFld = Nothing
            Set objShell = Nothing
        End If
    Next
    Erase jyogai
    Set fso = Nothing
    If Cells(4, 1) <> "" Then MsgBox ("非表示シートの削除が完了しました!")
End Sub

・コード内にコメントを入れているので細かい部分は解説を省略します
・24行目以下で、Excel.Application のオブジェクトを用意しています
Excelをインスタンス化して開くためです(画面のチラつきを防止するため)
・42~46行目で対象ファイルを開いています
44行目の「If GetInputState() Then DoEvents」は重いファイル対策用です
 DoEventsの代わりに②コードの先頭部分で使用を宣言するコードを1行入れています
 Private Declare Function GetInputState Lib “USER32” () As Long
74行目以降は、Shell.Application で閉じたファイルの更新日時を元に戻す処理です

②ファイルを指定(複数可)して非表示シートを削除するコード

Option Explicit
Private Declare Function GetInputState Lib "USER32" () As Long 'DoEventsの代わり
'選択ファイルの非表示シートを削除して日時変更せずに保存
Sub 個別ファイルを設定()
    Dim vFileName As Variant
    Dim strfld As Variant
    'フォルダとファイル名消去
    Cells(2, 1) = "" 'フォルダ消去
    Range(Cells(4, 1), Cells(4, 2).End(xlDown)) = ""
    '「ファイルを開く」ダイアログの表示
    vFileName = Application.GetOpenFilename( _
                FileFilter:="Excelワークブック,*.xls?", _
                Title:="ファイルを指定して下さい", _
                MultiSelect:=True)
    If IsArray(vFileName) = False Then _
                MsgBox ("処理を中止します!"): Exit Sub
    Dim f As Variant    'ファイル用
    Dim fn As Variant   'ファイル名保存用
    Dim d As Date       '更新日時保存用
    Dim sh As Worksheet 'ワークシート用
    Dim n As Long, i As Long 'カウンター用
    Dim jyogai(2) As String '除外シート名保存用
    For i = 0 To 2
        jyogai(i) = Cells(i + 12, 4)
    Next
    'チラつきをなくすためExcelインスタンスで対応
    Dim tgwb As Object
    Dim owb As Excel.Workbooks
    Dim oxl As Excel.Application
    '更新日時書き換えにShellオブジェクトを使う
    Dim objShell As Object
    Dim objFld As Object
    Dim objFile As Object
    Dim pw As String    'Password用
    Dim fso As Object   'ファイルシステムオブジェクト
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    pw = Cells(4, 5)
    i = 4  '4行目から開始なのでカウンター初期化
    For Each f In vFileName 'フォルダ内のファイルを取得
        If i = 4 Then '最初のファイルでフォルダ取得
            strfld = Left(f, InStrRev(f, "\")) 'フォルダPath
            Cells(2, 1) = strfld
        End If
        fn = fso.GetFilename(f) 'ファイル名セット
        Cells(i, 1) = fn
        d = fso.GetFile(f).DateLastModified ' 更新日時を取得
     
        Set oxl = CreateObject("Excel.Application") 'インスタンス
        Set owb = oxl.Application.Workbooks
        If GetInputState() Then DoEvents '重いファイル用対策
        'ファイルを開く
        Set tgwb = owb.Open(fileName:=f, UpdateLinks:=0, Password:=pw)
        '開いたブックに対する処理
        With tgwb
            '共有の場合解除
            If .MultiUserEditing = True Then
                .UnprotectSharing
                .ExclusiveAccess
            End If
            n = 0   '削除数カウント初期化
            For Each sh In .Worksheets '非表示シートを削除
                If sh.Visible = xlSheetHidden Then
                    Select Case sh.Name '除外シートを確認
                        Case jyogai(0), jyogai(1), jyogai(2)
                        Case Else: sh.Delete: n = n + 1 '削除
                    End Select
                End If
            Next sh
        End With
        If GetInputState() Then DoEvents 'DoEvents
        'ファイル保存して閉じる
        tgwb.Close (True)
        'オブジェクト初期化
        Set tgwb = Nothing
        Set owb = Nothing
        Set oxl = Nothing
        '削除したシート数を書き込む
        Cells(i, 2) = n
        i = i + 1   'インクリメント
        'ここから更新日時を戻す処理(不要の場合はパス)
        If Cells(3, 3) = 1 Then
            Set objShell = CreateObject("Shell.Application") 'インスタンス化
            Set objFld = objShell.Namespace(strfld) 'フォルダを取得
            Set objFile = objFld.ParseName(fn) 'ファイルを取得
            '更新日時を元に戻す
            objFile.ModifyDate = d
            'オブジェクト初期化
            Set objFile = Nothing
            Set objFld = Nothing
            Set objShell = Nothing
        End If
    Next
    Erase jyogai
    Set fso = Nothing
    If Cells(4, 1) <> "" Then MsgBox ("非表示シートの削除が完了しました!")
End Sub

・コード内にコメントを入れているので細かい部分は解説を省略します
・①の「フォルダ内ファイル」と基本的に同じロジックのコードです
・15行目のとおり、選択ファイルは配列になっています(オブジェクトでは無い)
・ので、要所でオブジェクトに変換しないとうまく動作しません
・45行目や47行目などがその例です。変換しないとオブジェクトエラーとなります

まとめ(おわりに)

まとめと感想など

・非表示シートはファイルを使いまわししているうちに、いつの間にか存在を忘れてしまい、気づいたらファイルが肥大化しているなんてことになっていたりします(^^;
・その肥大化したファイルを気づかずに各部署に配布してしまうなんてことも
・そんな時にこのツールを使えば、あっという間にスリム化できます
・細かいところに手が届くように、「パスワード設定」や「削除対象外設定」など
・思いついた部分は盛り込めたと思います
・「フォルダ指定」と「ファイル選択指定」の両方ともケースによって使い分けできますので是非一度使ってみてください(^^)/

今後の記事について

今回の記事はいかがだったでしょうか。お役に立てたなら幸いです(^^;
是非!サンプルファイルがありますのでそのまま使ってみてください(^^)/


【今後の記事内容はどうしようかなぁ・・・】
・今までに紹介した記事で使用したコードの改変も検討します
・高速化した「VlookUp関数」のVBAでの活用法を再検討してみたいと思います
・その他「小ネタいろいろ」などなど・・・・・
・今後これらのどれかについて記事にしていきたいと思います。ご期待ください(^^)/

サンプルファイルをダウンロードできます(下記リンク先へ)

記事で使用したサンプルファイルがダウンロードできるページを設置しています
こちら(このリンク先)からご利用ください