【ExcelVBA】シート名を部分一致で検索するアドイン

自分用のアドインのすゝめ

Excelは業務で毎日使用している方も多いアプリケーションだと思います。
でも、毎日使うものだからこそ、不満があることもあるでしょう。
そういうときはざっと検索してみます。大体は親切な人が解決法を載せてくれています。
でも、それで方法が見つからない場合、VBAでアドインを書いて解決しちゃうことが多いです。
汎用的な機能は特定ファイルに記述するのではなく、アドインとしてファイルに関係なく使用できるようにしておけば、いつでも使えてとても便利です。

アドインとは

アプリケーションの拡張機能のことで、アドオンと大体同じ意味です。
インストールとアンインストールの方法は、以下を参照してください。
Excel でアドインを追加または削除する - Office サポート
「Excel アドインを追加または削除する」のところに記載があります。

今回はシート名を部分一致で検索できるようにするアドインを作ります。
ついでなのでショートカットキーで起動できるようにしてみます。

シート名を部分一致で検索する

動作イメージ

起動すると、検索語句を入力するダイアログが表示されます。

「OK」を押下すると、入力した検索語句に部分一致するシートに移動します。

左端のシートから検索ではなく、現在のシートから右端のシートまで検索、なければ左端のシートから現在のシートまで検索という仕様にしています。
それでも見つからない場合、一致するシートが存在しない旨のメッセージを表示します。

アドインを作る

まずは新規ワークブックを開きます。Excelが起動しているところでCtrl＋Nとか押すとできます。
次にAlt+F11でエディタを開きます。
左側のプロジェクトエクスプローラーで開いているファイルを右クリックして「挿入」から「標準モジュール」を選択します。
「標準モジュール」というフォルダが作成され、「Module1」が追加されていますね。この「Module1」をダブルクリックして開きます。
コード本体をここに記述していきます。

検索ロジック

開いた「Module1」に以下をコピペします。
「Module1」のオブジェクト名は好きな名前に変えちゃってかまいません。

Option Explicit

Private Const NOT_FOUND_MSG As String = "一致するシートは存在しません"

Private Sub SearchSheetName()
    Application.ScreenUpdating = False
    Dim searchName As String: searchName = Application.InputBox( _
        Prompt:="検索語句を入力してください。", Title:="シート名検索", Default:=ActiveSheet.name, Type:=1 + 2)
    If Len(searchName) = 0 Then
        Exit Sub
    End If
    If Len(searchName) > 31 Then
        Call MsgBox(NOT_FOUND_MSG, vbCritical)
        Exit Sub
    End If

    With ActiveWorkbook
        ' アクティブシートの次から検索
        If FindSheetIdx(searchName, ActiveSheet.index + 1, .Sheets.Count) > 0 Then
            Exit Sub
        Else
            ' アクティブシート以降になかったので頭から検索
            If FindSheetIdx(searchName, 1, ActiveSheet.index) > 0 Then
                Exit Sub
            End If
        End If
    End With

    Call MsgBox(NOT_FOUND_MSG, vbCritical)
    Application.ScreenUpdating = True
End Sub

Function FindSheetIdx(ByVal searchName As String, ByVal startIdx As Integer, ByVal endIdx As Integer) As Integer
    FindSheetIdx = 0
    Dim i As Integer: For i = startIdx To endIdx
        With ActiveWorkbook.Sheets(i)
            If InStr(.name, searchName) > 0 Then
                Call .Activate
                FindSheetIdx = i
                Exit Function
            End If
        End With
    Next
End Function

コピペしたら処理のどこかにカーソルがある状態でF5を押してみてください。
「動作イメージ」と同じダイアログが表示されます。検索する部分はこれで完成です。

ショートカットキーの設定

次は「Module1」ではなく「ThisWorkbook」を開いて、以下をコピペします。

ショートカットキーは好きなように設定できます。
今回はCtrl＋Alt＋Fで起動するようにしました。
変更する場合は、以下の「設定するショートカットキー」のところをコメントに従って書き換えてください。

Application.OnKey "設定するショートカットキー", "起動するSub名"

Option Explicit

' +　がShirtキー、　^　がCtrlキー、　%　がAltキー
Private Sub Workbook_AddinInstall()
    ' ブックがアドインとして組み込まれた時
    ' ショートカットキー設定
    Application.OnKey "^%{f}", "searchSheetName"
End Sub

Private Sub Workbook_AddinUninstall()
    ' アドイン ブックの組み込みを解除した時
    ' 当該アドインで設定したキーを全て解除
    Application.OnKey "^%{f}"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 開いたブックを閉じる直前
    ' 当該アドインで設定したキーを全て解除
    Call Workbook_AddinUninstall
End Sub

Private Sub Workbook_Open()
    ' ブックを開く時
    ' ショートカットキー設定
    Call Workbook_AddinInstall
End Sub

アドインの保存

あとはファイルを保存するだけです。
保存ダイアログが表示されたら、「ファイルの種類」で「Excel アドイン(*.xlam)」を選択します。
保存場所はファイルの種類を選ぶと自動的にアドイン用のフォルダになりますので、そのままファイル名を入力して保存したら完成！
冒頭のExcel でアドインを追加または削除する - Office サポートを参考に、保存したアドインを有効にして下さい。

設定したショートカットキーを押してみてください。検索語句を入力するダイアログが表示されます。
なお、アドインを無効化すると設定したショートカットキーは使えなくなります。

自分に合わせたカスタマイズを

保存したアドインに機能を追加するには、「Module1」に動作するSubを記述、「ThisWorkbook」にショートカットキーの組み込みと解除を記述、アドインの無効化、有効化の手順を順に実施、の4つの手順でできます。
VBAが書けるならリファクタリングして最適化するといいですね。
ショートカットキーの設定部分を別関数にするとか。
頻繁に使わない機能ならショートカットキーではなく、メニューから呼び出すようにしてもいいです。

自分用のアドインで業務効率化を図りましょう！