Excelシートを検索する便利なマクロ

Sub シート検索()

    Dim buf As String
    Dim slctFlg As Boolean
    Dim i As Integer
    Dim cnt As Integer
    Dim shtNmbr As Integer
    Dim maxShtNmbr As Integer
    
    slctFlg = False
    maxShtNmbr = ActiveWorkbook.Worksheets.Count
    
    buf = InputBox("検索する文字列を入力してください。" & vbCrLf & "(""#""＋シート番号/シート名の一部/正規表現)", "シート検索")
    If "" = buf Then
        slctFlg = True
    ElseIf "#" = Left(buf, 1) Then
        'シート番号指定
        shtNmbr = Val(Mid(buf, 2))
        If 1 <= shtNmbr And shtNmbr <= maxShtNmbr Then
            cnt = 0
            For i = 1 To maxShtNmbr
                If ActiveWorkbook.Sheets(i).Visible Then
                    cnt = cnt + 1
                    If cnt = shtNmbr Then
                        ActiveWorkbook.Sheets(i).Select
                        slctFlg = True
                        Exit For
                    End If
                End If
            Next i
        End If
    ' 左端シート
    ElseIf "<" = buf Then
        ActiveWorkbook.Sheets(1).Select
        slctFlg = True
    ' 右端シート
    ElseIf ">" = buf Then
        ActiveWorkbook.Sheets(maxShtNmbr).Select
        slctFlg = True
    ' 正規表現
    Else
        For i = 1 To maxShtNmbr
            If TestReg(ActiveWorkbook.Sheets(i).Name, buf) Then
                If ActiveWorkbook.Sheets(i).Visible Then
                    ActiveWorkbook.Sheets(i).Select
                    slctFlg = True
                    Exit For
                End If
            End If
        Next i
    End If
    
    '該当なし
    If Not slctFlg Then
        MsgBox "該当するシートが見つかりません。"
    End If
    
End Sub

' 文字列検索(正規表現)
Function TestReg(str As String, ptn As String) As Boolean

    Dim re As Variant
    Dim flg As Boolean
    
    Set re = CreateObject("VBScript.RegExp")
    On Error GoTo errReg
    With re
        .Pattern = ptn
        .ignorecase = True
        .Global = True
        If .Test(str) Then
            flg = True
        End If
    End With
    
errReg:
    Set re = Nothing
    TestReg = flg

End Function