指定パターンのシート名のみ纏めて削除または残す

前回は指定文字を含むシート、または含まないシートを纏めて消してみた。
infoment.hatenablog.com
今日も、前回の続きから。

自動処理をする過程で、例えばこのように、年月を６ケタの数字で表した
名前のシートが複数登場する場合がある。

これらを「数字６桁」のようにパターンで探して消したり、或いは残したり
とする需要が、少なくとも私個人にはある。

ということで、作ってみた。これは昨日のものとほぼ同じだが、違いとして
「完全一致／部分一致」の引数は省いてある。パターンマッチには正規表現を
使用しているので、パターンを指定できる方であれば、そこで部分一致⇔完全
一致を併せて切り替えられるだろう、というのがその理由だ。

先日までと同様、下記はクラスモジュール「AppControl」に追記してある。

' 指定したパターンとマッチする名前のシートを残す、または削除。
Public Function RegExpSheetDelete(specified_pattern As String, _
                         Optional delete_type As DeleteType = DeleteType.sdDelete) As Boolean
                            
    Dim myReg As Object
    Set myReg = CreateObject("VBScript.RegExp")
    
        ' 正規表現のパターン設定。
        myReg.Pattern = specified_pattern
    Dim Ws As Worksheet
    
        On Error GoTo er:
        
        ' 各シート名を評価して選択削除。
        For Each Ws In Worksheets
        
            ' シート数が１の時点でループを抜ける。
            ' ※シート数１で削除しようとするとエラーになるため。
            If Worksheets.Count = 1 Then GoTo er:
            
            ' 指定パターンに一致する場合に削除。
            If delete_type = sdDelete Then
                If myReg.Test(Ws.Name) Then
                    If Not SheetDeleteWithoutAlerts(Ws) Then GoTo er:
                End If
            
            ' 指定パターンに一致しない場合に削除。
            Else
                If Not myReg.Test(Ws.Name) Then
                    If Not SheetDeleteWithoutAlerts(Ws) Then GoTo er:
                End If
            End If
        Next
        
        On Error GoTo 0
        
        RegExpSheetDelete = True
        Exit Function
        
er:

        On Error GoTo 0
        
        RegExpSheetDelete = False
        
End Function

それでは、こちらで確認してみよう。削除対象となるのは、一番左にある
「Sheet1」以外の３つだ（202106～202108）。

↓ これで、シート名が数字６桁のシートのみ、一括で削除する。

Sub Test()

    Dim ApC As VBAProject.AppControl
    Set ApC = New VBAProject.AppControl
        ApC.RegExpSheetDelete "^\d{6}$"

End Sub

こちらも、それなりに使えそうだ。
次回に続きます。

参考まで。