※ これは 2017/9/17 に個人ブログへ投稿した内容を転記したものです。
仕事上、膨大な品目リストから一つの項目を選ばせることが多々あります。
通常は検索やフィルターを使うのですが、リストが別シートにある場合など、行き来する必要があり操作が煩雑になります。
こんなとき、Googleみたいに候補を表示してくれたらいいのに良いのに…なんて思う大抵のことは、誰かがやっている。
Google 検索の「サジェスト機能」を, Excel のシート上にVBAで作る
エクセルでグーグルサジェストっぽい入力をする
先人は偉大ですね…!ありがとうございます。
この 2 つを使ってみて色々と気になるところがあったので、コードを整理しつつ両方を切り替えられるようにしてみました。VBE の操作方法や実際の挙動は元記事を参照してください。
コード
標準モジュール SuggestModule.bas
検索セルのあるシート SearchCellSheet.vba
検証環境: Excel 2013 / Windows10
候補リストを別シートに退避すべきか?
入力規則の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
Find から Foreach if Like に
Find
は処理時間が遅いという指摘がされているのと、なぜか MatchCase
が上手く行かなかったので Foreach
で辞書項目を回して比較するようにしました。
参考: VBAのFindメソッドの使い方には注意が必要です
処理が早くなっただけでなく、内容もわかりやすく簡潔に記述できていると思います。
大文字・小文字を区別したい場合は、
If strKey = "" Or UCase(item.Value) Like "*" & UCase(strMatch) & "*" Then
から UCase
を取り除いてください。2
(2017/10/25追記)
Like比較に使われるワイルドカード(?、*、#、[、])が含まれた語でも検索できるようにしました。なお、strMatch
という別の変数を使ったのは、strKey
を完全一致の判定に使用しているためです。3
なお、辞書範囲から空白項目を除去するために SpecialCells
を使っています。この関数は特定の種類のセルのみを抽出できる関数ですが、数式と文字列のどちらかを指定する必要があります。冒頭の DICTIONARY_CELL_TYPE
で指定してください。該当セルがない場合、ランタイムエラーになります。ちょっとクセのある関数なので、不具合が生じる場合はMSDNを参照してみてください。
確定時の処理と戻り値
二つ目の記事では候補が 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
注意事項
辞書に同じ項目が複数存在するときは、最初の項目が返ってきます。
記事に焼き直したところはデバッグしてないので、もし間違いがあったら教えてください。
-
この場合、復帰するにはイミディエイトウィンドウなどから
Application.EnableEvents = True
に設定する必要があります。
また、シート側で検索結果(例えば入力が確定したかどうか)に応じてシート内の他のセルも編集したいとき、シート側のApplication.EnableEvents
の間に処理を入れることで、シートに依存した処理をまとめて記述でき、モジュールの再利用性が高まります。 ↩ -
And
→Or
に修正しました(2017/10/25) ↩ -
現行の実装では"[]"を検索することはできません。また、Replaceは関数とRangeオブジェクトのメソッドとでは実装が異なるようで注意が必要でした。参考:【VBA入門】Replace関数とReplaceメソッドで文字列の置換
(追記以上) ↩