Использование ключевых слов для поиска записей и их перечисления в списке

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 выдает ошибку компиляции во втором «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

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")

OutPut:

(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условие для столбца для поиска. Вероятно, этот столбец является своего рода столбцом примечаний, но он будет работать для других типов полей описания для поиска.