时间戳

首页 > 解决方案 > Excel（VBA）：如何使我的组合框独立以允许用户确定的组合搜索数据库？

excel - Excel（VBA）：如何使我的组合框独立以允许用户确定的组合搜索数据库？

问题描述

我有一个带有 7 个组合框的用户表单，允许用户使用他们可能选择的某些标准来搜索数据。我的代码目前仅在用户对所有 7 个组合框进行选择/输入时才有效，但如果用户决定不在其中一个组合框中进行选择则不起作用。如何改进我的代码，以便用户可以选择组合组合框，例如按任意顺序组合 3 或 4 个（可能是组合框 2、4 和 7 等），并且仍然获得精确的数据？

for i=5 to totrows

If Trim(Worksheets("Data").Cells(i, 2)) = Trim(User_search.Cbx_Project_code) And _
       Trim(Worksheets("Data").Cells(i, 5)) = Trim(User_search.Cbx_TrueNOC) And _
       Trim(Worksheets("Data").Cells(i, 6)) = Trim(User_search.Cbx_DNAmass) And _
       Trim(Worksheets("Data").Cells(i, 7)) = Trim(User_search.Cbx_Kit) And _
       Trim(Worksheets("Data").Cells(i, 8)) = Trim(User_search.Cbx_QIndex) And _
       Trim(Worksheets("Data").Cells(i, 9)) = Trim(User_search.Cbx_Injection_time) And _
       Trim(Worksheets("Data").Cells(i, 10)) = Trim(User_search.Cbx_Instrument) Then
       Worksheets("Data").Rows(i).EntireRow.Select
       Selection.Copy
       Workbooks.Open "C:\Users\Desktop\" & Wk_name & (".xlsx")
       Worksheets("Results").Activate
       Cells(1, 1).Activate
       totrows = Worksheets("Results").Cells(Rows.count, 1).End(xlUp).Row
       Workbooks("Data.xlsm").Worksheets("Data").Paste Destination:=Worksheets("Results").Cells(totrows + 1, 1)
       Workbooks.Open "C:\Users\Desktop\Data.xlsm"
       Worksheets("Data").Activate 
 end if

next i

标签： excelvbacombobox

解决方案

请测试下一个代码。如果我的（最后）理解是正确的，它应该做你想做的事。它不需要任何激活，选择...

Sub selectiveQuery()
  Dim sh As Worksheet, i As Long, totRows  As Long, totR  As Long, Wk_name As String, wb As Workbook, shR As Worksheet
  Dim cbPr As MSForms.ComboBox, cbTr As MSForms.ComboBox, cbDn As MSForms.ComboBox, cbK As MSForms.ComboBox
  Dim cbQ As MSForms.ComboBox, cbInj As MSForms.ComboBox, cbInstr As MSForms.ComboBox
   
  Set sh = Worksheets("Data")'Workbooks("Data.xlsm") must be activated...
  totRows = sh.Range("B" & Rows.count).End(xlUp).row 'last row of "Data" sheet
  'combo boxes variable definition, in order to compact and make the code easy to be understood:
  Set cbPr = User_search.Cbx_Project_code: Set cbTr = User_search.Cbx_TrueNOC
  Set cbDn = User_search.Cbx_DNAmass: Set cbK = User_search.Cbx_Kit
  Set cbQ = User_search.Cbx_QIndex: Set cbInj = User_search.Cbx_Injection_time
  Set cbInstr = User_search.Cbx_Instrument
  
  Wk_name = "your workbook name" '!!!
  Set wb = Workbooks.Open("C:\Users\Desktop\" & Wk_name & ".xlsx")
  Set shR = wb.Worksheets("Results")
  
  For i = 5 To totRows
    If (Trim(sh.Cells(i, 2)) = Trim(cbPr.Value) Or cbPr.Value = "") And _
            (Trim(sh.Cells(i, 5)) = Trim(cbTr.Value) Or cbTr.Value = "") And _
            (Trim(sh.Cells(i, 6)) = Trim(cbDn.Value) Or cbDn.Value = "") And _
            (Trim(sh.Cells(i, 7)) = Trim(cbK.Value) Or cbK.Value = "") And _
            (Trim(sh.Cells(i, 8)) = Trim(cbQ.Value) Or cbQ.Value = "") And _
            (Trim(sh.Cells(i, 9)) = Trim(cbInj.Value) Or cbInj.Value = "") And _
            (Trim(sh.Cells(i, 10)) = Trim(cbInstr.Value) Or cbInj.Value = "") Then

       totR = shR.Cells(Rows.count, 1).End(xlUp).row
       sh.Rows(i).EntireRow.Copy Destination:=shR.Cells(totR + 1, 1)
  Next i
  sh.Activate
End Sub

它也True为空组合值的情况提供了条件......

当然，代码未经测试。我没有这样的文件，我没有这种带有必要组合框的表格。这是一段代码，理论上应该可以工作。如果出现错误，请检查我是否正确匹配了所涉及的组合和他们的真实姓名......

推荐阅读