不添加到comboboxVB​​A的项目

我正在使用Excel VBA将string从另一个工作表的单元格行放置到combobox下拉列表中。 当用户input到combobox中时，下拉列表应该过滤结果为只包含与combobox中键入的字符相同的结果。 但是，我无法得到代码来使这种行为发生。 代码似乎只抓取数据表中每个string的第一个字符，而不匹配任何string的任何位置的字符。

当工作簿打开时：

Public Sub Workbook_Open() InitnewCmb End Sub 

newMdl：

这部分工作：

 Public newCol As Collection Public indNewCol As Long Public lastColumn As Long Public newCargoNum As Long Public Sub InitnewCmb() 'Initialize combobox lastColumn = Database.Cells.SpecialCells(xlCellTypeLastCell).Column Set newCol = New Collection newCargoNum = 0 With newCol For indNewCol = 2 To lastColumn .Add Database.Cells(2, indNewCol).Value 'Take the value of each cell, a string and add to the collection of strings newCargoNum = newCargoNum + 1 Next indNewCol End With 

这是事情失控的地方。 FilternewCmb现在在InitnewCmb中被调用

 FilternewCmb "" End Sub Public Sub FilternewCmb(newFilter As String) Dim l As Long For l = 1 To newCargoNum If InStr(1, newCol.Item(l), newFilter, vbTextCompare) <> 0 Then 'If entered character matches a character in any string in collection Tool.newCmb.AddItem newCol.Item(l) 'keep these strings in dropdown End If Next l End Sub 

有人可以请指出我正确的方向，为什么过滤不工作？ 最后，一旦在下拉列表中select了一个项目，我希望该项目填充combobox，并使下拉列表消失，这应该很容易。

谢谢。

Answer 1

此设置将在您键入时过滤combobox下拉列表

在Sheet1上创build一个新的combobox（ActiveX控件），如下图所示，名为“ComboBox1”

将此代码添加到Sheet1 VBA模块：

 Option Explicit Private cLst As Variant Private Sub Worksheet_SelectionChange1(ByVal Target As Range) cLst = Sheet1.UsedRange.Columns(1) Sheet1.ComboBox1.List = cLst Sheet1.ComboBox1.ListIndex = -1 End Sub Private Sub ComboBox1_Change() filterComboList Sheet1.ComboBox1, cLst End Sub Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) Sheet1.ComboBox1.DropDown End Sub Private Sub ComboBox1_GotFocus() 'or _MouseDown() Sheet1.ComboBox1.DropDown End Sub Public Sub filterComboList(ByRef cmb As ComboBox, ByRef dLst As Variant) Dim itm As Variant, lst As String, sel As String Application.EnableEvents = False With cmb sel = .Value If IsEmpty(cLst) Then cLst = Sheet1.UsedRange.Columns(1) For Each itm In cLst If Len(itm) > 0 Then If InStr(1, itm, sel, 1) Then lst = lst & itm & "||" Next If Len(lst) > 0 Then .List = Split(Left(lst, Len(lst) - 2), "||") Else .List = dLst End With Application.EnableEvents = True End Sub 

---

在Sheet1上更改单元格select以刷新下拉列表