検索可能なコンボボックスにユーザーフォームの混乱の一覧が表示される

Question

ユーザーフォームとドロップダウンリストを持つコンボボックスがあります。しかし、コンボボックスの1つにはドロップダウンの項目が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