2016-07-21 24 views
0

コンボボックスに値を追加する場合、ユーザーがコンボボックスに文字を入力すると、コンボボックスのドロップダウン機能が表示されますそれらの文字を含むアイテムのみ、Google検索バーの動作と同様です。(Excel VBA)ComboBoxのオートコンプリート機能をドロップダウンリストとして表示する方法

Google Search Bar http://intersites.com/resources/uploads/suite_131/google_bar.png

コード編集:ここでは

Option Explicit 
Option Compare Text 

Public LC As Long 
Public Count As Integer 
Dim ComboArray() As String 

'Initializes the userform, and saves values from database into an array 
Private Sub UserForm_Initialize() 
LC = Cells(1, Columns.Count).End(xlToLeft).Column 

ReDim ComboArray(1 To LC) 

For Count = 1 To LC 
    ComboArray(Count) = Cells(1, Count).Value 
Next Count 
End Sub 

'Prevents changes if the down key is pressed? 
Private Sub ComboBox_SiteName_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 
Application.ScreenUpdating = False 
End Sub 

'Adds values to combobox if they contain the string input by user 
Private Sub ComboBox1_Change() 
Dim pos As Integer 
Dim i As Integer 

ComboBox1.Clear 

For Count = 1 To LC 
    pos = InStr(1, ComboArray(Count), ComboBox1.Value) 
    If pos <> 0 Then 
     With ComboBox1 
      .AddItem Cells(1, Count) 
     End With 
    End If 
Next Count 
End Sub 
+0

、私が最初に(正しく動作)リスト項目を初期化しようとしました。私が求めているドロップダウン・エフェクトを作成するには、コードはすべてのアイテムのコンボボックスをクリアしてから、コンボボックス・エントリー・ポイント内の文字列と各値を比較し、その文字列を含む値だけを追加します。このコードは、コンボボックスに変更があるたびに、特に入力されたテキストが実行されるたびに実行されます。 –

+0

私が尋ねることは、あなたが今までに望んでいた機能*に関して何を試してみたかです。今、あなたは問題を解決するためのゼロの試みを示しました。あなたはちょうどコンボボックスリストの値を初期化する方法を示しました。あなたは '_Change'イベントで何かする必要があることを知っています。あなたは 'VBA.Strings'クラスとそのクラスに関連する関数を知っていますか? –

+0

私はドロップダウンで一致するデータをコンボボックスに表示させることができました。ただし、新しいテキストが入力されたときにドロップダウンボックスが自動的に表示されるようにしたいと思います。 –

答えて

0

があなたの目的のために改善が必要な場合があります簡単な例ですが、ユーザー入力の文字列を構築するためにKeyPressイベントを使用しての一般的な原則を示していますそれをリスト内の各項目と比較して、が入力文字列で始まる値にリストを効果的にフィルタリングします。

これは、私がやろうとしたバックスペース、削除などを処理するためには少し洗練が必要ですが、私が望む限りは得られませんでした。

コード:示されたコードで

Option Explicit 
Dim cbList As Variant 
Dim userInput$ 

'### USERFORM EVENTS 
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 
    Select Case KeyCode 
     Case 8, 48 
      'MsgBox "Backspace" 
      Debug.Print "Backspace" 
      If userInput <> "" Then 
      userInput = Left(userInput, Len(userInput) - 1) 
      End If 
     Case 46 
      'MsgBox "Delete" 
      Debug.Print "Delete" 
      userInput = Replace(userInput, ComboBox1.SelText, "") 
    End Select 
End Sub 
Private Sub UserForm_Activate() 
    Dim cl As Range 
    userInput = "" 
    For Each cl In Range("A1:A8") 
     Me.ComboBox1.AddItem cl.Value 
    Next 
    Me.ComboBox1.MatchRequired = False 
    cbList = Me.ComboBox1.List 
End Sub 
Private Sub UserForm_Terminate() 
    userInput = "" 
End Sub 
'#### END USERFORM EVENTS 
'#### COMBOBOX EVENTS 

Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 
    Me.ComboBox1.List = cbList 
    ' Capture the user input in module variable 
    userInput = userInput & Chr(KeyAscii) 
    Debug.Print "input: " & userInput 
    Debug.Print KeyAscii 
    Dim i As Long, itm 
    For i = Me.ComboBox1.ListCount - 1 To 0 Step -1 
     itm = Me.ComboBox1.List(i) 
     If Not StartsWith(CStr(itm), userInput) Then 
      Me.ComboBox1.RemoveItem i 
     End If 
    Next 

    If Me.ComboBox1.ListCount = 0 Then 
     Me.ComboBox1.List = cbList 
    Else 
     Me.ComboBox1.List = Me.ComboBox1.List 
    End If 
    Me.ComboBox1.DropDown 

End Sub 
'#### END COMBOBOX EVENTS 

'#### HELPER FUNCTIONS 
Function StartsWith(imtVal$, inputStr$, Optional caseSensitive As Boolean = False) 
', Optional caseSensitive As Boolean = False 
    'If Not caseSensitive Then 
     imtVal = LCase(imtVal) 
     inputStr = LCase(inputStr) 
    'End If 
    StartsWith = VBA.Strings.Left(imtVal, Len(inputStr)) = inputStr 
End Function 
'#### END HELPER FUNCTIONS 
関連する問題