【Excel VBA】シート検索

gistfile1.bas

Option Explicit

Sub シート検索()
    Const TITLE As String = "シート検索"
    Const DEFAULT_EXPLANATION As String = "表示したいシート名を入力してください。"

    Dim conversion As VbStrConv
    Dim explanation As String
    Dim find As String
    Dim sheet_name As String
    Dim find_converted As String
    Dim name_converted As String
    Dim found As Boolean
    Dim sheet_cnt As Long
    Dim current As Long
    Dim i As Long
    
    conversion = vbLowerCase + vbNarrow + vbKatakana
    sheet_cnt = Worksheets.Count
    found = False

    Do
        If found = True Then
            explanation = DEFAULT_EXPLANATION & vbLf & vbLf _
                        & "現在のシート: " & sheet_name
        Else
            explanation = DEFAULT_EXPLANATION
        End If

        find = InputBox(explanation, TITLE, find)
        If find = "" Then Exit Do

        find_converted = StrConv(find, conversion)
        current = ActiveSheet.Index
        found = False
        
        For i = 1 To sheet_cnt
            current = (current Mod sheet_cnt) + 1
            sheet_name = Worksheets(current).Name
            name_converted = StrConv(sheet_name, conversion)
            If name_converted Like "*" & find_converted & "*" Then
                found = True
                Exit For
            End If
        Next i

        If found = True Then
            Worksheets(current).Activate
        Else
            MsgBox "見つかりませんでした。" & vbTab, vbExclamation, TITLE
        End If
    Loop
End Sub