是否可以使用自动过滤器或在字典上查找？

Question

所以我有一个带有comboBox的用户表单作为动态搜索框。

需要搜索的数据位于另一个工作簿（1200多行）中。为了避免不断打开和关闭该数据工作簿，我在表单初始化期间将其全部加载到字典中。

现在我的问题是：是否可以快速过滤字典数据（并更新组合框），因为用户正在输入或我是否需要更改我的方法？

任何帮助将不胜感激。

这是我到目前为止的代码：

Option Explicit
Private emplDict As Object
'all other constants and functions are declared in a separate module named "code"
Private Sub btnClose_Click()
    Unload Me
End Sub
Private Sub comboSearch_Change()
    Me.comboSearch.DropDown
End Sub
Private Sub UserForm_Initialize()
    Dim xlWS As Worksheet
    Dim xlWB As Workbook
    Dim rng As Range
    Dim lstRw As Long
    Dim item As Variant

    Application.Run "code.xlHelper", False ' turn off screen updating, alerts, events

    Set emplDict = CreateObject("scripting.dictionary")
    Set xlWB = Workbooks.Open(Filename:=SUB_PLANNING & EMPLOYEE_LIST)
    Set xlWS = xlWB.Sheets("namen_werknemers")

    With xlWS
        lstRw = .Cells(Rows.Count, 1).End(xlUp).Row
        Set rng = .Range(.Cells(2, 1), .Cells(lstRw, 1))
    End With

    For Each item In rng
        If Not emplDict.exists(item.Value) Then
            emplDict.Add item.Text, item.Offset(0, 1).Text
        End If
    Next

    xlWB.Close False

    Set xlWS = Nothing
    Set xlWB = Nothing

    Application.Run "code.xlHelper", True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Set emplDict = Nothing
End Sub

Answer 1

关键是使用词典的键。

使用VBA Filter方法返回已过滤密钥的数组。

Private EEDict As Object

Private Sub cboEEList_Change()
    Dim Keys
    Keys = EEDict.Keys
    cboEEList.List = Filter(Keys, cboEEList.Text, True, vbTextCompare)
    cboEEList.DropDown

End Sub

Private Sub UserForm_Initialize()
    Dim arData
    Dim x As Long

    Set EEDict = CreateObject("scripting.dictionary")

    arData = Worksheets("Employees").Range("A1").CurrentRegion.Value2

    For x = 2 To UBound(arData)
        EEDict(arData(x, 1)) = arData(x, 2)
    Next

    cboEEList.List = EEDict.Keys
End Sub

我从Fusion Tables - Employees.csv

获取了示例数据

Answer 2

一种不同的方法，但有点混乱就是记录集，就像这样，你需要在它上面添加excel范围，我已经拼凑了一些值。

Option Explicit

Private rs As ADODB.Recordset

Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

Set rfiltered = New ADODB.Recordset
rs.Filter = "Value like '" & Chr(KeyAscii) & "*'"

If Not rs.EOF Then
    Range("e1").CopyFromRecordset rs
    Me.ComboBox1.RowSource = "E1:E10"
End If

End Sub


Private Sub UserForm_Initialize()

Set rs = New ADODB.Recordset
Dim fieldsArray(1) As Variant
Dim values(1) As Variant

rs.Fields.Append "Key", adVarChar, 5
rs.Fields.Append "Value", adVarChar, 5

fieldsArray(0) = "Key"
fieldsArray(1) = "Value"

values(0) = 4
values(1) = "as"

rs.Open
rs.AddNew fieldsArray, values
rs.Update

End Sub