未添加到组合框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，如下图所示，名为＆＃34; ComboBox1＆＃34;

将此代码添加到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上的单元格选择以刷新下拉列表