使用关键字查找记录并在列表框中列出它们 [英] Using keywords to find records and list them in a listbox
问题描述
我有一个窗体(frmSearch)，我使用几个(4)组合框来过滤出列表框(lstCustomers)的结果.我现在试图做的是创建一种基于关键字"文本框过滤列表框的功能.此外，关键字框将搜索的列将基于cboWhere为可变的，而cboWhere是来自tblContacts的列的列表(qryContactWants使用的表)
我发现了一个非常好的带有以下代码的函数集，该函数集使我可以过滤所有内容，但我不确定如何将这些数据转过来并用于过滤列表框.
此功能可组织关键字:
I have a form (frmSearch) that I use several (4) comboboxes to filter out results for a listbox (lstCustomers). What I'm attempting to do now is create the ability to filter the listbox based on a text box of "keywords". Additionally, the column which the keyword box will search will be variable based on cboWhere which is a list of columns from tblContacts (the table qryContactWants uses)
I found a really nice Function set with the following code that will let me filter everything, but I'm not entirely sure how to turn this data around and use it to filter out my listbox.
This function organizes the keywords:
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
此函数实际上执行搜索:
And this function actually performs the search:
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上的组合框来过滤列表框的代码:
And here is the code that I typically use to filter the listbox using the comboboxes on 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 = SQL & "AND qryContactWants.VARIABLECOLUMNHERE =SOMETHING
What I would like to do is take the functions I found for searching keywords and apply it to my form and aid in returning a list of customers in lstCustomers
Ideally, having the keyword function return an SQL statement similar to those I'm using to filter out the listbox would be perfect. This would allow me to add a simple SQL = SQL & "AND qryContactWants.VARIABLECOLUMNHERE =SOMETHING
编辑1 :
使用以下代码时，VBA在第二个如果结束"处抛出编译错误，指出没有如果结束".显然有，所以我不确定发生了什么.这是我正在使用的代码:
EDIT 1:
While using the following code, VBA is tossing a compile error on the second "End If" stating there isn't a Block If. There clearly is, so I'm not sure what's going on. Here is the code I'm using:
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代码:
And under the function RequerylistCustomers() I added the If IsNull (Me.txtSearch) = False Then code below:
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
推荐答案
要搜索的关键字是否在单个列中(例如，注释或备注列?).如果是的话，那么您应该可以选择将一个附加条件添加"到当前组合框"过滤器的集合"中.
Are the keywords to be searched in a single column (say a comments or memo column?). If yes, then you should be able to optional "add" the one additional criteria to your current "set" of combo box filters.
我们是否假定关键字可以出现在该备忘录列中的任何位置以进行搜索?
Are we to assume that the keywords can appear anywhere in that memo column to search?
因此，如果在该文本框中输入了关键字"，则可以调用KeyWhere.
So, if there are "key words entered into that text box, then you call 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
我们假设每个关键字用逗号分隔(可以是空格，但逗号更好).
We assume each key word is separated by a comma (could be space, but comma is better).
那么，如果我在调试窗口中键入以下命令来测试以上内容?
So, if I type in the following command in debug window to test the above?
? keywhere("Generator, Water maker, Battery","Notes")
输出:
(Notes like '*Generator*' or Notes like '*Water maker*' or Notes like '*Battery*')
因此，我们只是将以上结果附加到您的最终SQL中.
So, we just append the above results to your final SQL.
例如:
dim strWhere as string
if isnull(me.KeyWordBox) = False then
strWhere = keyWhere(me.KeyWordBox,me.cboColumnToSearch)
SQL = SQL & " AND " & strWhere
end if
因此，以上代码将所有关键字转换为有效的SQL条件，以供搜索列.该列可能是某种注释"列，但对于其他描述类型字段而言，它可以工作.
so, the above converts all keywords into a valid SQL condition for the column to search. It is likely that column is some kind of notes column, but it would work for other description type field to search.
这篇关于使用关键字查找记录并在列表框中列出它们的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
