☰

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為您的來源資料。

在此輸入影像描述

標準代碼模組

您需要在 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或找到僅選取具有值的儲存格的另一種方法。

相關內容