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

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

Answer 1

是否在单个列中搜索关键字（例如注释或备注列？）。如果是，那么您应该可以选择“添加”一个额外的标准到您当前的“组合”组合框过滤器。

我们是否假设关键字可以出现在该备忘录列中的任何位置进行搜索？

因此，如果在该文本框中输入了“关键词，那么您将调用KeyWhere。

例如这个例程：

?  keywhere("Generator, Water maker, Battery","Notes")

我们假设每个关键词用逗号分隔（可以是空格，但逗号更好）。

那么，如果我在调试窗口中键入以下命令来测试上面的内容？

(Notes like '*Generator*' or Notes like '*Water maker*' or Notes like '*Battery*')

输出：

dim strWhere   as string
if isnull(me.KeyWordBox) = False then
  strWhere = keyWhere(me.KeyWordBox,me.cboColumnToSearch)
  SQL = SQL & " AND " & strWhere
end if

因此，我们只是将上述结果附加到您的最终SQL。

例如：

qazxswpoi

因此，上面将所有关键字转换为有效的SQL条件以供搜索列。列可能是某种注释列，但它可以用于搜索其他描述类型字段。