Excel (VBA): как сделать мои поля со списком независимыми, чтобы позволить пользовательским комбинациям искать в базе данных? - PullRequest
Новая
       99

Excel (VBA): как сделать мои поля со списком независимыми, чтобы позволить пользовательским комбинациям искать в базе данных?

0 голосов
/ 14 июля 2020

У меня есть пользовательская форма с 7 полями со списком, которая позволяет пользователю искать данные по некоторому критерию, который они могут выбрать. Мой код в настоящее время работает только в том случае, если пользователь делает выбор / ввод во всех 7 комбинированных списках, но не работает, если пользователь решает не делать выбор в одном из комбинированных списков. Как я могу улучшить свой код, чтобы пользователь мог выбирать комбинации комбинированных списков, например, 3 или 4 ответа в любом порядке (возможно, комбинированные списки 2,4 и 7 и т. Д. c) и при этом получать точные данные? 

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

1 Ответ

0 голосов
/ 15 июля 2020

Пожалуйста, протестируйте следующий код. Если мое (последнее) понимание верное, он должен делать то, что вы хотите. Не требует активации, выбора ... 

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 и для случая пустого значения комбо ...

Код, из Конечно, не проверял. У меня нет таких файлов, нет такой формы с необходимыми комбо-боксами. Это кусок кода, который теоретически должен работать. Если возникнет какая-то ошибка, проверьте, правильно ли я сопоставил задействованную комбинацию с их настоящим именем ...

...