可搜索的组合框，其中包含用户表单上的建议列表 [英] searchable combo box with a list of sugggestion on a userform

问题描述

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

I have a user form and some combo boxes with drop down lists. However one of the combo boxes has almost 1000 items in the drop down and I'd like the user to be able to start typing a word in the combo box and get a list of suggestions to choose from based on the word entered eg if they type 'joh' in the combo box I want to show them a list of all the choices in the drop down that contains 'joh' so they can select the one they want. The combo box with almost 1000 items that needs the functionality above is named 'cboProgrammeName'. I should say that the VBA below already provides this functionality but not entirely. At the moment if I type 'joh' in my combo box, then I have to click the arrow at the right of the combo box to see all the given suggestions based on 'joh'. But what I want is VBA to automatically pop up the list of suggestions WITHOUT me having to click the arrow. Is that possible? My user form has a lot of vba but I think the part that is relevant for this issue is below. Although I can post on here all my VBA code if it helps. Thanks in advance

 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

推荐答案

您可以尝试类似的方法...

You may try something like this...

将以下代码放在UserForm模块上. 如果需要，请更改图纸和范围引用.

Place the following code on UserForm Module. Change the Sheet and Range references if required.

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

这篇关于可搜索的组合框，其中包含用户表单上的建议列表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！