时间戳

首页 > 解决方案 > 有一个列表框，用于过滤我的子表单中作为查询的项目

vba - 有一个列表框，用于过滤我的子表单中作为查询的项目

问题描述

我有一个列表框，在表单上有三个不同的类别可供选择。我有正在运行的 vba 代码，它允许我在列表框中选择多个项目，这很好。但是我选择的项目很难得到我需要的结果。

举个例子；列表框中的三个类别不在具有实际类别名称的查询中。我拥有的一个类别称为“拣货”，好吧，我想选择“拣货”，然后当单击按钮时，我希望它拉出查询字段“项目编号”中的所有项目，该字段等于“0801”，代表类别“采摘”。

注意按钮后面的代码是一个简单的“点击”事件过程

**我遇到问题的列表框称为（StrAccounts）

**在我尝试在 tbUpload 中过滤的查询中选择与 Acct 相同的内容

**我希望列表框中的“选择”类别在 Acct = '0801' 的查询中过滤 Acct

**Placed_Orders 是我的 ListBox 中的第二个类别名称，它与“tbUpload”、Acct 上方的查询中的字段相同，除了我希望这个 Placed_Orders 获取所有 Acct （'1108'、'1114'、'1117'、 “1113”、“1110”）

**查询 tbUpload 中不包含上面已经提到的以下数字的任何 Acct 是我列表框中的第三个类别，即“Not_Placed”

**因此，每当单击列表框中的 Not_Placed 并选择搜索按钮时，我希望查询中的 Accts 拉出，Accts <> '0801','1108','1114','1117','1113',' 1110'

Private Sub cmdSearch_Click()
Dim Varitem As Variant
Dim StrDEPT_OBS As String
Dim StrStatus As String
Dim StrACCT As String
Dim strSQL As String
Dim StrAccounts As String

'get selections from DEPT_OBS multiselect listbox
For Each Varitem In Me!List_Dept_OBS.ItemsSelected
StrDEPT_OBS = StrDEPT_OBS & ",'" & Me!List_Dept_OBS.ItemData(Varitem) & "'"
Next

'get selections from Status multiselect listbox
For Each Varitem In Me!List_Status.ItemsSelected
StrStatus = StrStatus & ",'" & Me!List_Status.ItemData(Varitem) & "'"
Next

'get selections from Accts multiselect listbox
 For Each Varitem In Me!List_ACCTs.ItemsSelected
 StrStatus = StrAccounts & ",'" & Me!List_ACCTs.ItemData(Varitem) & "'"
 Next



 If Len(StrDEPT_OBS) > 0 Then
 StrDEPT_OBS = Right(StrDEPT_OBS, Len(StrDEPT_OBS) - 1)
 Else: MsgBox "You must enter an OBS"

 Exit Sub
 End If

 If Len(StrStatus) > 0 Then
 StrStatus = Right(StrStatus, Len(StrStatus) - 1)
 End If

 If Len(StrAccounts) > 0 Then
 StrAccounts = Right(StrAccounts, Len(StrAccounts) - 1)
  End If



  strSQL = " SELECT * FROM tbUpload WHERE "
  strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") AND "
    If Len(StrStatus) = 0 Then
        strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") "

    Else
        strSQL = strSQL & "tbUpload.OPR_STAT_ID IN (" & StrStatus & ") "
   End If



    If Len(StrAccounts) = 0 And StrAccounts = "Picking" Then
        strSQL = strSQL & "tbUpload.ACCT like (" & [0801] & ")"

    Else
    End If

    If Len(StrAccounts) = 0 And StrAccounts = "Placed_Orders" Then
     strSQL = strSQL & "tbUpload.ACCT IN (" & [1108] & [1114] & [1117] & [1113] & [1110] & ") "

    Else
        strSQL = strSQL & "tbUpload.ACCT <> (" & [0801] & [1108] & [1114] & [1117] & [1113] & [1110] & ") " "Not_Placed"
End If




DoCmd.SetWarnings False
''DoCmd.OpenQuery ("UPLOAD")
 Me![tbUpload subform].Form.RecordSource = strSQL

 End Sub









If Len(StrAccounts) > 0 Then
'' StrAccounts = Right(StrAccounts, Len(StrAccounts) - 1)
StrAccounts = StrAccounts & ",'" & Me!List_ACCTs.ItemData(Varitem) & "'"
End If


strSQL = " SELECT * FROM tbUpload WHERE "
strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") AND "
    If Len(StrStatus) = 0 Then
        strSQL = strSQL & "tbUpload.DEPT_ID IN (" & StrDEPT_OBS & ") "

    Else
        strSQL = strSQL & "tbUpload.OPR_STAT_ID IN (" & StrStat   us & ") "
   End If



    If StrAccounts = "Lugging" Then
        strSQL = strSQL & "tbUpload.ACCT like (" & [0801] & ")"

    Else
    End If

    If StrAccounts = "Structure" Then
     strSQL = strSQL & "tbUpload.ACCT IN (" & [1108] & [1114] & [1117] & [1113] & [1110] & ") "

    Else
    End If

标签： vbaformsms-accesslistboxlistbox-control

解决方案

考虑：

'get selections from DEPT_OBS multiselect listbox
For Each Varitem In Me.List_Dept_OBS.ItemsSelected
   StrDEPT_OBS = StrDEPT_OBS & ",'" & Me.List_Dept_OBS.ItemData(Varitem) & "'"
Next

If Len(StrDEPT_OBS) > 0 Then
    StrDEPT_OBS = "[Dept_ID] IN(" & Right(StrDEPT_OBS, Len(StrDEPT_OBS) - 1) & ") AND "
Else
    MsgBox "You must enter an OBS"
    Exit Sub
End If

'get selections from Status multiselect listbox
For Each Varitem In Me.List_Status.ItemsSelected
    StrStatus = StrStatus & ",'" & Me.List_Status.ItemData(Varitem) & "'"
Next

If Len(StrStatus) > 0 Then
   StrStatus = "[OPR_STAT_ID] IN(" & Right(StrStatus, Len(StrStatus) - 1) & ") AND "
End If

'get selection from Accts single select listbox and build account parameters array
Select Case Me.List_Accts
    Case "Picking"
        StrAccounts = "ACCT = 0801 AND "
    Case "Placed_Orders"
        StrAccounts = "ACCT IN(1108,1114,1117,1113,1110) AND "
    Case "Not_Placed"
        StrAccounts = "NOT ACCT IN(0801,1108,1114,1117,1113,1110) AND "
End Select

strSQL = StrDEPT_OBS & StrStatus & StrAccounts
If strSQL <> "" Then
    strSQL = " WHERE " & Left(strSQL, Len(strSQL) - 5)
End If

Me.[tbUpload subform].Form.RecordSource = "SELECT * FROM tbUpload" & strSQL & ";"

有关使用 VBA 动态构建搜索条件的更多信息，请查看http://allenbrowne.com/ser-62.html

推荐阅读