在使用 VBA 填充列表的 Excel 中键入下拉列表时自动完成

Question

我正在使用下面的代码将数据插入另一个工作表的下拉列表中。这是当用户从另一个下拉列表中选择某个选项时实现的。

lstRow = Sheets("Data Sheet").Range("D" & Rows.Count).End(xlUp).Row
Sheets("Data Insert").Range("C3").Select
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:="='Associated British Ports'!$G$7:$G" & lstRow
    .IgnoreBlank = False
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = "Invalid Selection"
    .InputMessage = ""
    .ErrorMessage = _
    "Please select a user from the list or select New User as the configuration type."
    .ShowInput = True
    .ShowError = True
End With

我想添加一个功能，当用户输入几个字母时，它会搜索列表并消除任何不包含该字母的内容。 IE。说我在下拉列表中有以下内容： 托马斯 c史密斯 f 格雷厄姆 埃文斯 大卫 B马修斯

并且用户输入“th” 剩余的值应该是

托马斯 c史密斯 B马修斯

即使是用户必须以 A Th.... 的形式输入名称的简化版本。如果上述方法不可行，返回 A Thomas 也可以。

我见过这个http://www.ozgrid.com/Excel/autocomplete-validation.htm 和这个Excel data validation with suggestions/autocomplete

但我认为我不确定如何将其与上述代码集成，或者甚至有可能！

谁能帮帮我？

TIA :)

Answer 1

这是我的 SAYT（键入时搜索）功能。我的表单有一个包含用户列表的列表框控件和一个可用于搜索列表的文本框控件。

Private Sub txtSearch_Change()
    Dim x As Integer

    lstUsers.ListIndex = -1
    For x = 0 To lstUsers.ListCount - 1
        lstUsers.ListIndex = x
        If InStr(1, LCase(lstUsers.Text), LCase(txtSearch.Text), vbTextCompare) > 0 _
        Or InStr(1, LCase(lstUsers.List(x, 1)), LCase(txtSearch.Text), vbTextCompare) > 0 _
        Then
            Exit Sub
        End If
    Next x
End Sub

Private Sub txtSearch_KeyPress(ByVal KeyAscii As msforms.ReturnInteger)
    If KeyAscii = 13 Then
        txtSearch.Text = lstUsers.Text
    End If
End Sub

在您键入时，每次击键都会触发 txtSearch_Change 事件，它会循环遍历列表框的值，直到找到第一个匹配项并将其选中。我们还检查 KeyPress 事件以查看用户是否按下 Enter（ASCII 13）来自动完成搜索。我的不区分大小写（我 LCase 一切），但您可以轻松地将其修改为区分大小写（甚至添加一个复选框，以便用户可以选择区分大小写！）