项目未添加到组合框VB​​A

Question

我正在使用Excel VBA将另一个工作表的单元格行中的字符串放入组合框下拉列表中。 当用户在组合框中键入内容时，下拉列表应将结果过滤为仅包含与在组合框中键入相同字符的结果。 但是，我无法获得使此行为发生的代码。 该代码似乎仅从数据表中的每个字符串中获取第一个字符，而与任何字符串中任何位置的字符都不匹配。

打开工作簿时：

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

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

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

有人可以为我指出正确的方向，为什么过滤不起作用？ 最后，一旦在下拉菜单中选择了一个项目，我希望该项目填充组合框并使下拉菜单也消失，这应该很容易。

谢谢。

Answer 1

键入时，此设置将过滤ComboBox下拉列表

如图所示，在Sheet1（ActiveX控件）上创建一个新的ComboBox，名为“ 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上的单元格选择以刷新下拉列表