☰

Excel カスタム オートコンプリート

tag-icon • tag-icon microsoft-excel autocomplete
Excel カスタム オートコンプリート

Excel ファイルのシートに長いリストがあります:

Number   Value
123      Text 123
127      Another text
131      Yet another text
...      ...

別のシートで、これらの数字を入力する必要があります。しかし、どの数字がどのテキストに属しているかを思い出せないので、どの値がどの数字に属しているかを示す何らかのオートコンプリート機能が欲しいです。たとえば、 と入力すると12、次の内容を示すツールヒントが表示されます。

123 - Text 123
127 - Another text

123とは両方とも127で始まるからです12。

そのようなことは可能ですか? 組み込み機能で可能か、アドインまたは VBA スクリプトを作成することで可能かは関係ありません。

答え1

結果

これは、VBA (VBScript ではありません!) で実行できることです。セルの値が変更されるたびに、コメントが自動的に作成されます。

結果

コード

ソース範囲

コードを機能させるには、名前付き範囲 Sourceソースデータ用。

ここに画像の説明を入力してください

標準コードモジュール

これを実現するために必要な 2 つの関数については、Visual Basic エディター ( Alt+ F11) で標準コード モジュールを作成する必要があります。 への参照Microsoft Scripting Runtimeも設定する必要があります。

参考文献

次のコードを標準コード モジュールに貼り付けます。

Option Explicit

Function GetMatches(strInput As String) As String
    Dim dict As Scripting.Dictionary
    Dim key As Variant
    Dim strOutput As String

    strOutput = "Matches found:" & vbCrLf

    Set dict = GenerateDictionary()

    For Each key In dict.Keys
        If key Like strInput & "*" Then strOutput = _
            strOutput & vbCrLf & key & " - " & dict(key)
    Next

    GetMatches = strOutput
    Set dict = Nothing
End Function

Private Function GenerateDictionary() As Scripting.Dictionary
    Dim source As Range
    Dim cell As Range
    Dim dict As New Scripting.Dictionary
    Dim number As Integer
    Dim value As String

    Set source = Range("Source").SpecialCells(xlCellTypeConstants)

    For Each cell In source
        If cell.Row < 2 Then GoTo PassRow
        If cell.Column = 1 Then number = cell.value
        If cell.Column = 2 Then value = cell.value
        If number <> 0 And value <> "" And cell.Column = 2 Then _
            dict.Add number, value
PassRow:
    Next

    Set GenerateDictionary = dict
    Set dict = Nothing
End Function

このコードでは、数値が列 1 にあり、値が列 2 にあることを前提としています。また、最初の行はスキップされます。必要に応じて調整することができます。

ワークシートコード

次のコードをワークシートコードに貼り付けます

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strInput As String

    If Not Intersect(Target, Me.Range("D1")) Is Nothing Then
        strInput = Target.value
        Target.ClearComments
        Target.AddComment (GetMatches(strInput))
        Target.Comment.Shape.TextFrame.AutoSize = True
    End If
End Sub

Me.Range任意の単一セルに変更できます。

使用法

指定したセルに値を入力するだけで、一致するすべての値を含むコメントが自動的に追加されます。

懸念事項

このコードは、一致を検索するたびに辞書を作成します。小規模から中規模のSource範囲では大きな問題にはなりません (10,000 までテストしましたが、それでも数ミリ秒で実行されました)。

一致が多数ある場合、コメントが画面からはみ出す傾向があります。これを解決する唯一の方法は、より具体的な値を入力することです。

を使用すると、範囲内の空白セルSourceは無視されますが、これは数式では機能しません。 に切り替えるか、値のあるセルのみを選択する別の方法を見つけるxlCellTypeConstants必要があります。xlCellTypeFormulas

関連情報