使用关键字查找记录并将其列在列表框中

Question

我有一个表单（frmSearch），我使用几个（4）组合框来过滤掉列表框（lstCustomers）的结果。我现在尝试做的是创建基于“关键字”文本框过滤列表框的功能。此外，关键字框将搜索的列将基于cboWhere变量，tblContacts是qryContactWants列表（使用的表） Public Function FindAnyWord(varFindIn, strWordList As String) As Boolean Dim var Dim aWords aWords = Split(strWordList, ",") For Each var In aWords If FindWord(varFindIn, var) Then FindAnyWord = True Exit Function End If Next var End Function 我找到了一个非常好的功能集，下面的代码可以让我过滤掉所有内容，但我不完全确定如何转换这些数据并使用它来过滤掉我的列表框。此功能组织关键字：

    Public Function FindWord(varFindIn As Variant, varWord As Variant) As Boolean

   Const PUNCLIST = """' .,?!:;(){}[]-—/"
   Dim intPos As Integer

   FindWord = False

   If Not IsNull(varFindIn) And Not IsNull(varWord) Then
       intPos = InStr(varFindIn, varWord)

       ' loop until no instances of sought substring found
       Do While intPos > 0
           ' is it at start of string
           If intPos = 1 Then
               ' is it whole string?
               If Len(varFindIn) = Len(varWord) Then
                   FindWord = True
                   Exit Function
               ' is it followed by a space or punctuation mark?
               ElseIf InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
                   FindWord = True
                   Exit Function
               End If
           Else
               ' is it precedeed by a space or punctuation mark?
               If InStr(PUNCLIST, Mid(varFindIn, intPos - 1, 1)) > 0 Then
                   ' is it at end of string or followed by a space or punctuation mark?
                   If InStr(PUNCLIST, Mid(varFindIn, intPos + Len(varWord), 1)) > 0 Then
                       FindWord = True
                       Exit Function
                   End If
               End If
           End If

           ' remove characters up to end of first instance
           ' of sought substring before looping
           varFindIn = Mid(varFindIn, intPos + 1)
           intPos = InStr(varFindIn, varWord)
       Loop
   End If

End Function

而这个函数实际上执行搜索：

frmSearch

这里是我通常使用Dim column As String SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _ & "FROM qryContactWants " _ & "WHERE 1=1 " If cboType.Value & "" <> "" Then SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'" End If If cboMake.Value & "" <> "" Then SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'" End If If cboModel.Value & "" <> "" Then SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'" End If If cboYear.Value & "" <> "" Then SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'" End If If cboCondition.Value & "" <> "" Then SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'" End If SQL = SQL & " ORDER BY qryContactWants.Last" Me.lstCustomers.RowSource = SQL Me.lstCustomers.Requery End Sub上的组合框过滤列表框的代码：

lstCustomers

我想做的是采取我找到的搜索关键字的功能，并将其应用到我的表格，并帮助返回SQL = SQL & "AND qryContactWants.VARIABLECOLUMNHERE =SOMETHING的客户列表理想情况下，让关键字函数返回一个类似于我用来过滤掉列表框的SQL语句将是完美的。这将允许我添加一个简单的

编辑1：在使用以下代码时，VBA在第二个“End If”上抛出编译错误，指出没有Block If。显然有，所以我不确定发生了什么。这是我正在使用的代码： Public Function KeyWhere(strKeys As String, strColumn As String) As String Dim b As Variant strKeys = Replace(strKeys, vbCrLf, ",") ' remove all line returns b = Split(strKeys, ",") Dim strWhere As String Dim v As Variant For Each v In b If Trim(b) <> "" Then If strWhere <> "" Then strWhere = strWhere & " or " strWhere = strWhere & strColumn & " like '*" & Trim(v) & "*'" End If End If Next strWhere = "(" & strWhere & ")" KeyWhere = strWhere End Function

RequerylistCustomers()

在功能If IsNull (Me.txtSearch) = False Then下我添加了Private Sub RequerylstCustomers() Dim SQL As String 'Dim criteria As String Dim column As String SQL = "SELECT qryContactWants.ID, qryContactWants.FullName, qryContactWants.Type, qryContactWants.Make, qryContactWants.Model, qryContactWants.YearWanted, qryContactWants.Condition " _ & "FROM qryContactWants " _ & "WHERE 1=1 " If cboType.Value & "" <> "" Then SQL = SQL & " AND qryContactWants.Type = '" & cboType.Value & "'" End If If cboMake.Value & "" <> "" Then SQL = SQL & " AND qryContactWants.Make = '" & cboMake.Value & "'" End If If cboModel.Value & "" <> "" Then SQL = SQL & " AND qryContactWants.Model = '" & cboModel.Value & "'" End If If cboYear.Value & "" <> "" Then SQL = SQL & " AND qryContactWants.YearWanted = '" & cboYear.Value & "'" End If If cboCondition.Value & "" <> "" Then SQL = SQL & " AND qryContactWants.Condition = '" & cboCondition.Value & "'" End If Dim strWhere As String 'Grab Keywords from txtSearch using cboWhere to search for those keywords If IsNull(Me.txtSearch) = False Then strWhere = KeyWhere(Me.txtSearch, Me.cboWhere) SQL = SQL & " AND " & strWhere End If SQL = SQL & " ORDER BY qryContactWants.Last" Me.lstCustomers.RowSource = SQL Me.lstCustomers.Requery End Sub代码如下：

Public Function KeyWhere(strKeys As String, strColumn As String) As String


  Dim b    As Variant
  strKeys = Replace(strKeys, vbCrLf, ",") ' remove all line returns

  b = Split(strKeys, ",")
  Dim strWhere   As String
  Dim v    As Variant
  For Each v In b
     if trim(v) <> "" then
        If strWhere <> "" Then strWhere = strWhere & " or "
        strWhere = strWhere & strColumn & " like '*" & Trim(v) & "*'"
     end if
  Next
  strWhere = "(" & strWhere & ")"
  KeyWhere = strWhere

End Function