Excelセルにサジェスト(予測変換)機能をつける

仕事上、膨大な品目リストから一つの項目を選ばせることが多々あります。
通常は検索やフィルターを使うのですが、リストが別シートにある場合など、行き来する必要があり操作が煩雑になります。
こんなとき、Googleみたいに候補を表示してくれたらいいのに良いのに…なんて思う大抵のことは、誰かがやっている。

language-and-engineering.hatenablog.jp

suugleblog.blogspot.jp

先人は偉大ですね…!ありがとうございます。
この2つを使ってみて色々と気になるところがあったので、コードを整理しつつ両方を切り替えられるようにしてみました。VBEの操作方法や実際の挙動は元記事を参照してください。

標準モジュール

検索セルのあるシート

候補リストを別シートに退避すべきか?

”入力規則のFormula1に直接突っ込める文字数は255文字までの制限があるらしい。”
とのことですが、私の環境ではもっと突っ込めました。一つの項目がよほど長くない限りは、一つ目の方法で良さそうです。つまり、

Const USE_SUGGEST_LIST_SHEET = False

で、ほとんどの場合は十分だと思います。
候補リストを別シートに移した場合の不具合として、検索セルが複数あると、最新の候補がすべてのセルに反映されてしまいます。たとえば、一つ目の検索セルを「はてな」で確定したのに、二つ目の検索セルに「Ya」と入力すると、一つ目のセルにも「Yahoo」「Yaplog」などの候補が入力されてしまいます。
ただ、入力規則に直接入れる方法で保存すると、次に開いたときに同じシートに手動で設定した入力規則が壊れていることが多いようです…。誰か、対策方法が分かったら教えてくださいm(_ _)m
(2017/10/25追記)
どうやら入力規則は255文字以上のリストを表示することはできるのですが、保存ができないためにファイルが壊れてしまうようです。
対策として、255文字を超える場合には省略を示すOVERFLOW_DESCRIPTIONをリストに追加して、それ以上の項目を追加しないように修正しました。他にも、255文字を超える場合のみ候補リストを別シートに退避させる(つまりUSE_SUGGEST_LIST_SHEET = True)ような実装も有効だと思います。
(追記以上)

主な変更点

Application.EnableEvents

参照元のコードのようにApplication.EnableEventsを標準モジュール内に置くと、複数の検索セルがあって同時に削除やペーストをしたときに再帰的に呼び出されてしまい、途中でエラーを出してFalseのまま関数が終了してしまうことがあります。*1
また、シート側で検索結果(例えば入力が確定したかどうか)に応じてシート内の他のセルも編集したいとき、シート側のApplication.EnableEventsの間に処理を入れることで、シートに依存した処理をまとめて記述でき、モジュールの再利用性が高まります。

FindからForeach if Likeに

Findは処理時間が遅いという指摘がされているのと、なぜかMatchCaseが上手く行かなかったのでForeachで辞書項目を回して比較するようにしました。
excel-ubara.com
処理が早くなっただけでなく、内容もわかりやすく簡潔に記述できていると思います。
大文字・小文字を区別したい場合は、

If strKey = "" Or UCase(item.Value) Like "*" & UCase(strMatch) & "*" Then

からUCaseを取り除いてください。*2

(2017/10/25追記)
Like比較に使われるワイルドカード(?、*、#、[、])が含まれた語でも検索できるようにしました。なお、strMatchという別の変数を使ったのは、strKeyを完全一致の判定に使用しているためです。*3
(追記以上)

なお、辞書範囲から空白項目を除去するためにSpecialCellsを使っています。この関数は特定の種類のセルのみを抽出できる関数ですが、数式と文字列のどちらかを指定する必要があります。冒頭のDICTIONARY_CELL_TYPEで指定してください。該当セルがない場合、ランタイムエラーになります。ちょっとクセのある関数なので、不具合が生じる場合はMSDNを参照してみてください。
Range.SpecialCells メソッド (Excel)

確定時の処理と戻り値

二つ目の記事では候補が1つになった場合に確定としていましたが、辞書に「goo」と「Google」がある場合に確定できません。本記事のコードでは検索語と候補の文字列が完全一致した場合にのみ確定としています。
戻り値には完全一致した辞書項目のセルを返しています。完全一致した場合のみの処理は以下のように記述できます。

If Not( Suggest(DicSheetName, DicRangeAddress, target, target.Count = 1) Is Nothing ) Then
    '処理内容
End If

また、辞書シートの検索範囲以外から情報を得ようとする場合、たとえば、A列の検索範囲に「Google」などの項目が入っていて、B列に「https://google.com」などのURLが格納されている場合、

Dim foundCell As Range
Set foundCell = Suggest(DicSheetName, DicRangeAddress, target, target.Count = 1)
If Not( foundCell Is Nothing ) Then
    '処理内容、例えば
    'target.Offset(0,1) = foundCell.Offset(0,1)
End If

といった記述が可能です。*4

注意事項

辞書に同じ項目が複数存在するときは、最初の項目が返ってきます。
記事に焼き直したところはデバッグしてないので、もし間違いがあったら教えてください。

*1:この場合、復帰するにはイミディエイトウィンドウなどからApplication.EnableEvents = Trueに設定する必要があります。

*2:And→Orに修正しました(2017/10/25)

*3:現行の実装では"[]"を検索することはできません。また、Replaceは関数とRangeオブジェクトのメソッドとでは実装が異なるようで注意が必要でした。参照:【VBA入門】Replace関数とReplaceメソッドで文字列の置換 | 侍エンジニア塾ブログ | プログラミング入門者向け学習情報サイト

*4:Range.Offset プロパティ (Excel)