带有用户表单上的建议列表的可搜索组合框

Question

我有一个用户表单和一些带有下拉列表的组合框。但是，其中一个组合框的下拉菜单中有近 1000 个项目，我希望用户能够开始在组合框中输入一个单词，并根据输入的单词获得一个可供选择的建议列表，例如，如果他们在组合框中键入“joh” 我想向他们显示包含“joh”的下拉列表中所有选项的列表，以便他们可以选择他们想要的选项。包含近 1000 个需要上述功能的项目的组合框名为“cboProgrammeName”。我应该说下面的 VBA 已经提供了这个功能，但并不完全。目前，如果我在组合框中键入“joh”，则必须单击组合框右侧的箭头才能查看基于“joh”的所有给定建议。但我想要的是 VBA 自动弹出建议列表，而无需我单击箭头。那可能吗？我的用户表单有很多 vba，但我认为与此问题相关的部分如下。虽然如果有帮助，我可以在这里发布我所有的 VBA 代码。在此先感谢

 Private Sub UserForm_Initialize()


'Add the drop down lists to combo boxes
 Dim cProgrammeName As Range
 Dim cTaskName As Range
 Dim cUserName As Range

Dim ws As Worksheet
Set ws = Worksheets("XXX")


  For Each cProgrammeName In ws.Range("ProgrammeNameList")
  With Me.cboProgrammeName
.AddItem cProgrammeName.Value
.List(.ListCount - 1, 1) = cProgrammeName.Offset(0, 1).Value
 End With
 Next cProgrammeName




  For Each cTaskName In ws.Range("TaskNameList")
 With Me.cboTaskName
.AddItem cTaskName.Value
 End With
 Next cTaskName


For Each cUserName In ws.Range("UserNameList")
With Me.cboUserName
.AddItem cUserName.Value
End With
 Next cUserName

Me.txtDate.Value = "dd/mm/yyyy"
Me.txtComments.Value = "please type text here if required"
Me.cboProgrammeName.SetFocus
Me.cboProgrammeName.Value = "type text to open a list of choices"
Me.cboTaskName.Value = "click the arrow to open a list of choices"
Me.cboUserName.Value = "click the arrow to open a list of choices"

 End Sub

Answer 1

你可以试试这样的……

将以下代码放在用户窗体模块上。 如果需要，更改工作表和范围引用。

Private Sub cboProgrammeName_Change()
Dim ws As Worksheet
Dim x, dict
Dim i As Long
Dim str As String
Set ws = Sheets("XXX")
x = ws.Range("ProgrammeNameList").Value
Set dict = CreateObject("Scripting.Dictionary")
str = Me.cboProgrammeName.Value
If str <> "" Then
    For i = 1 To UBound(x, 1)
        If InStr(LCase(x(i, 1)), LCase(str)) > 0 Then
            dict.Item(x(i, 1)) = ""
        End If
    Next i
    Me.cboProgrammeName.List = dict.keys
Else
    Me.cboProgrammeName.List = x
End If
Me.cboProgrammeName.DropDown
End Sub