使用 MS Access 组合框在键入时进行搜索答案

【问题标题】：Search as you type with MS Access Combobox使用 MS Access 组合框在键入时进行搜索
【发布时间】：2016-02-26 19:47:05
【问题描述】：

我想在 Microsoft Access 中创建一个简单的“即键入即搜索”组合框，如下图所示。

注意：上面的图片来自我试图从here实现的复杂实现@

我的组合框名为ctlSearch。使用 Visual Basic，我想连接到onChange 事件，检测用户输入，从而优化可能结果的列表。是否可以采用这种方法来实现“键入即搜索”组合框？

【问题讨论】：

我相信 Adarsh 的回答并不能完全提供 OP 正在寻找的解决方案。如果我没记错的话，Adarsh 的解决方案假定搜索文本框与组合框是分开的。根据 OP，搜索框与 OP 发布的图像中显示的组合框相同。 OP 希望组合框在用户在组合框文本字段中键入时过滤其记录集。我相信 OP 问题的答案在 OP 提供的链接上，这里是experts-exchange.com/articles/6490/…

标签： vba ms-access combobox ms-access-2010

【解决方案1】：

这是我用来过滤组合框的函数：

Public Sub FilterComboAsYouType(combo As ComboBox, defaultSQL As String, lookupField As String)
Dim strSQL As String
    If Len(combo.Text) > 0 Then
        strSQL = defaultSQL & " WHERE " & lookupField & " LIKE '*" & combo.Text & "*'"
    Else
        strSQL = defaultSQL    'This is the default row source of combo box
    End If
    combo.RowSource = strSQL
    combo.Dropdown
End Sub

将组合框 Auto Expand 属性设置为 False 并调用 Sub 更改事件中的 FilterComboAsYouType 如下：

Private Sub cmbProductName_Change()
    FilterComboAsYouType Me.cmbProductName, "SELECT * FROM Product", "ProductName"
End Sub

【讨论】：

【解决方案2】：

您可以像这样设置组合或列表框：

SELECT ID,Hotel,Location FROM Sometable t 
WHERE t.Hotel 
LIKE "*" & Forms!YourForm!txtSearch.Text & "*"
ORDER BY t.Hotel

然后在 Change 事件中重新查询组合或列表框。

【讨论】：

我认为 iPwnTech 正在尝试在组合内输入，而不是使用单独的文本框。

【解决方案3】：

感谢 Vlado，您的回答鼓舞人心，简洁且带有 gif 说明。几天前，一位要求严格的客户要求我提供相同的功能。

但是，请求是进行类似 google 的搜索。换句话说，允许在目标组合中随机（在您键入时）搜索 [部分地] 包含多个短语（当然是 ANDed）。文本（这是多个“标签”字段的串联，包括鸡尾酒名称、酒精（Y/N）、成分、玻璃器皿、品牌、类别......等。

现在我又被问到同样的问题。我想把它附在这里以供将来搜索以帮助其他人（被困的程序员）。再次感谢弗拉多。

给你：

Public Sub GoogleSearch(combo As ComboBox, OriginalSQL As String, LookupField As String)
' - OriginalSQL is not the recursive one  
' - Use queries to build up your sql statement, then copy/paste thier sql text in the combo row source  
'   do not just point the row source to the query name (keep the query for reference if you like.
'   to avoid the quotation agony of VBA built-in editor to create your OriginalSQL
' - Always store your OriginalSQL in global module variable,
' - Initiate it on (form) load, restore it on cancel AND after_update
' Created by Walid Zohair, not to be used without the exact comments

If Trim(combo.Text) = "" Or IsNull(combo.Text) Then
    combo.RowSource = OriginalSQL
    combo.Requery
    combo.Dropdown
    combo.SetFocus
    Exit Sub
End If

Dim SQLStr As String
SQLStr = Replace(OriginalSQL, ";", "") ' make sure a bar end sql is used

' make sure order_by, group_by, Having will not be after where clause (gives error)
' This also can be used to give clearer names in outer SQL to be used in Where clause later
SQLStr = "SELECT * FROM ( " & SQLStr & " ) WHERE "

Dim StrArray() As String
StrArray = Split(Trim(combo.Text)) ' for saftey could be limited to up to 100 records only = Split(combo.text, " ", 100)
For i = 0 To UBound(StrArray)
    SQLStr = SQLStr & LookupField & " LIKE '*" & StrArray(i) & "*'"

    If UBound(StrArray) - i > 0 Then
        SQLStr = SQLStr & " AND " ' Add AND to the search string
    End If
Next i
combo.RowSource = SQLStr
combo.Dropdown
End Sub

此外，根据 SO 社区指南，我相信这可以更多地考虑到问题（更好的答案），而不是对其他答案的反应。

【讨论】：

【解决方案4】：

尝试使用它这比您提到的来源要简单得多。

Option Compare Database
Option Explicit
'************* Code Start **************
' This code was originally written by OpenGate Software
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' OpenGate Software    http://www.opengatesw.net

Function fLiveSearch(ctlSearchBox As TextBox, ctlFilter As Control, _
                      strFullSQL As String, strFilteredSQL As String, Optional ctlCountLabel As Control)
'==================================================================================
'  THIS FUNCTION ALLOWS YOU TO FILTER A COMBO BOX OR LIST BOX AS THE USER TYPES
'  ALL YOU NEED TO DO IS PASS IN THE CONTROL REFERENCE TO THE SEARCH BOX ON YOUR
'  FORM, THE LISTBOX/COMBO BOX YOU WANT TO FILTER, AND WHAT THE FULL AND FILTERED
'  SQL (ROWSOURCE) SHOULD BE.
'
'  ctlSearchBox       THE TEXTBOX THE USER TYPES IN TO SEARCH
'
'  ctlFilter          THE LISTBOX OR COMBOBOX ON THE FORM YOU WANT TO FILTER
'
'  strFullSQL         THE FULL ROWSOURCE YOU WANT TO DISPLAY AS A DEFAULT IF NO
'                     RESULTS ARE RETURNED
'
'  strFilteredSQL     THE FILTERED ROWSOURCE FOR THE LISTBOX/COMBOBOX; FOR EXAMPLE
'                     YOU WOULD WANT TO USE '...like ""*" & me.txtsearch.value & "*"""
'                     TO FILTER THE RESULTS BASED ON THE USER'S SEARCH INPUT
'
' ctlCountLabel       (OPTIONAL) THE LABEL ON YOUR FORM WHERE YOU WANT TO DISPLAY THE
'                     COUNT OF ROWS DISPLAYED IN THE LISTBOX/COMBOBOX AS THEY SEARCH
'=====================================================================================

'ADVANCED PARAMETERS - Change these constants to change the behaviour of the search
  Const iSensitivity = 1 'Set to the number of characters the user must enter before the search starts
  Const blnEmptyOnNoMatch = True 'Set to true if you want nothing to appear if nothing matches their search


10    On Error GoTo err_handle

          'restore the cursor to where they left off
20        ctlSearchBox.SetFocus
30        ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1

40        If ctlSearchBox.Value <> "" Then
                 'Only fire if they've input more than two characters (otherwise it's wasteful)
50               If Len(ctlSearchBox.Value) > iSensitivity Then
60                   ctlFilter.RowSource = strFilteredSQL
70                   If ctlFilter.ListCount > 0 Then
80                       ctlSearchBox.SetFocus
90                       ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
100                   Else
110                     If blnEmptyOnNoMatch = True Then
120                      ctlFilter.RowSource = ""
130                     Else
140                      ctlFilter.RowSource = strFullSQL
150                     End If
160                   End If
170             Else
180               ctlFilter.RowSource = strFullSQL
190             End If

200        Else
210           ctlFilter.RowSource = strFullSQL
220        End If

            'if there is a count label, then update it
230         If IsMissing(ctlCountLabel) = False Then
240           ctlCountLabel.Caption = "Displaying " & Format(ctlFilter.ListCount - 1, "#,##0") & " records"
250         End If

260   Exit Function
err_handle:
270   Select Case Err.Number
    Case 91 'no ctlCountLabel
       'exit
280       Case 94 'null string
       'exit
290       Case Else
300         MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description & _
            vbCrLf & "Error " & Err.Number & vbCrLf & "Line: " & Erl
310   End Select


End Function
'   ***** Code End ******

【讨论】：

【解决方案5】：

我进行了广泛的搜索，这与我所做的最接近，所以我会把我的脚本留在这里。这是关于将多个短语放在一个文本框中并让它在一个字段中搜索并在一个列表框（如谷歌）中产生结果。我在医学领域工作，因此术语和短语可能非常复杂。

上面Smart Man的帖子和我做过的类似，我尝试了他的方法但没有成功。具有挑战性的是他所做的 For 循环的制定，但我的版本将 WHERE 子句更改为 SQL 语句，并且它最多搜索四个短语，如 google。我对预期短语的数量进行了硬编码，如果有人想出纠正 For Loop 的方法，请随时分享。我只有一个 For 循环可以一次处理两个短语，而不是多个短语。

在我见过的其他搜索方法中，您必须按照它们在表格中的顺序输入短语，这限制了用户，尤其是在医学领域。所以这里......

 Private Sub txtbox_Change()

    Dim text As String
    Dim output As String
    Dim ArrayNo As Integer
    
    text = Me.txtbox.text
    
    Dim whereclause() As String
    
        whereclause = Split(text, " ")
        
        'output = Join(whereclause, "*")  'This will cause the search to be in order of the entry/array. We really want it in any order
    
        'Using a method for 4 string phrases
        ArrayNo = UBound(whereclause)
       
       If ArrayNo < 1 Then
                output = Join(whereclause(), " Table.FieldName LIKE '*") 'String that works for first array
            ElseIf ArrayNo = 1 Then
              output = whereclause(0) & "*' And Table.FieldName Like '*" & whereclause(1) & ""
            ElseIf ArrayNo = 2 Then
               output = whereclause(0) & "*' And Table.FieldName Like '*" & whereclause(1) & "*' And Table.FieldName Like '*" & whereclause(2) & ""
            ElseIf ArrayNo = 3 Then
                output = whereclause(0) & "*' And Table.FieldName Like '*" & whereclause(1) & "*' And Table.FieldName Like '*" & whereclause(2) & "*' And Table.FieldName Like '*" & whereclause(3) & ""
        End If
            
    Dim SQL As String
    
     SQL = "SELECT Table.FieldName FROM icd10_codes_combined " & _
                " WHERE Table.FieldName LIKE '*" & output & "*' "
    
        List.Visible = True
        List.RowSource = SQL
    
    End Sub

【讨论】：

【解决方案6】：

试试这个 VBA 代码：

Public Function ComboBoxSearch(P_ComboBox As Control, P_DefaultSql As String, P_FieldSeachName As String)
    Dim V_SearchStr As String
    If Me.ActiveControl.Name = P_ComboBox.Name Then
        V_SearchStr = P_ComboBox.Text
    Else
        V_SearchStr = P_ComboBox
    End If
    If Len(V_SearchStr) Then
        Dim P_DefaultSql2 As String
        If P_DefaultSql Like "*ORDER*" Then
            P_DefaultSql2 = Mid(P_DefaultSql, InStr(1, P_DefaultSql, "ORDER"))
            P_DefaultSql = Left(P_DefaultSql, InStr(1, P_DefaultSql, "ORDER") - 1)
        End If
        P_ComboBox.RowSource = P_DefaultSql & " WHERE " & _
        P_FieldSeachName & " LIKE '*" & V_SearchStr & "*'" & P_DefaultSql2
    Else
        P_ComboBox.RowSource = P_DefaultSql
    End If
    P_ComboBox.Dropdown
    P_ComboBox.SelLength = Len(V_SearchStr)
End Function

【讨论】：

【解决方案7】：

Vlado 的回答很棒，但如果您尝试使用箭头键，它会清除搜索结果。这是我想出的解决方法：

Private Const RecordSQL As String = "SELECT [HH_ID], [DisplayName] FROM _HOUSEHOLDS"

Private Sub ctlSearch_Change()
'filter dropbox as you type
    Dim rs As Recordset
    Set rs = CurrentDb.OpenRecordset(RecordSQL & " WHERE DisplayName = '" & ctlSearch.text & "' ORDER BY [DisplayName]")
    
    If (rs.BOF And rs.EOF) Then 'only requery on no exact match
        ctlSearch.RowSource = RecordSQL & " WHERE DisplayName Like '*' & ctlSearch.text & '*' ORDER BY [DisplayName]"
        ctlSearch.Dropdown
    End If
End Sub

Private Sub cbxAddHH_AfterUpdate()
    'reset dropdown list
    ctlSearch.RowSource = RecordSQL
End Sub

如果你的组合框包含重复的值，这肯定不会起作用，但我希望这会有所帮助。

【讨论】：