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 = SQL & "AND qryContactWants.VARIABLECOLUMNHERE =SOMETHING

编辑1 ：

使用以下代码时，VBA在第二个“如果结束”处抛出编译错误，指出没有“如果结束”。显然有，所以我不确定发生了什么。这是我正在使用的代码：

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

Answer 1

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

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

因此，如果在该文本框中输入了“关键字”，则可以调用KeyWhere。

例如此例程：

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

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

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

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

输出：

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

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

例如：

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

因此，以上代码将所有关键字转换为有效的SQL条件，以供搜索列。该列可能是某种“注释”列，但对于其他描述类型字段而言，它可以工作。

使用关键字查找记录并在列表框中列出它们

1 个答案: