使组合框专有/精确地生成数据

如何解决使组合框专有/精确地生成数据

我有一个带有7个组合框的用户窗体，用于从工作表中搜索数据。我打算将第6栏（质量）和第8栏（索引）列为范围，即质量：0.007-0.1; 0.11-2.5； 0.251-0.5等。其他5个组合框只是绝对值（不是范围）。我试图遍历数据表（shD）中的单元格，并且每当行匹配时都匹配用户窗体上进行的所有选择；然后将整行复制到结果表（shR）。用户可以将某些组合框留为空白，但是它们仍然应该能够获得结果。代码现在正在执行的操作可能是在我选择的15秒钟组合框（cbInj）中说的；该代码将包括20秒，与组合框上的15秒不匹配。这是我的代码；

'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  

    'Check selection for mass and present it as a range
    If Len(cbDn.Value) > 0 Then
        arrDn = Split(cbDn.Value,"-")
        mnDn = CDbl(arrDn(0))
        mxDn = CDbl(arrDn(1))
    End If

    'checkfor Index if selected and present it as a range
    If Len(cbQ.Value) > 0 Then
        arrQ = Split(cbQ.Value,"-")
        mnQ = CVar(arrQ(0))
        mxQ = CVar(arrQ(1))
    End If

        'count the total rows on Data
         totD = shD.Range("B" & Rows.Count).End(xlUp).Row 'last row of "Data" sheet

        For i = 5 To totD
            vDn = shD.Cells(i,6).Value
            vQ = shD.Cells(i,8).Value
            If (Trim(shD.Cells(i,2)) = Trim(cbPr.Value) Or cbPr.Value = "") And _
            (Trim(shD.Cells(i,5)) = Trim(cbTr.Value) Or cbTr.Value = "") And _
            vDn > mnDn And vDn <= mxDn Or cbDn.Value = "" And _
            (Trim(shD.Cells(i,7)) = Trim(cbK.Value) Or cbK.Value = "") And _
            vQ > mnQ And vQ <= mxQ Or cbQ.Value = "" And _
            (Trim(shD.Cells(i,9)) = Trim(cbInj.Value) Or cbInj.Value = "") And _
            (Trim(shD.Cells(i,10)) = Trim(cbInstr.Value) Or cbInstr.Value = "") Then

            totR = shR.Cells(Rows.Count,1).End(xlUp).Row
            shD.Rows(i).EntireRow.Copy Destination:=shR.Cells(totR + 1,1)
    End If

   Next i

解决方法

“范围”测试中的轻微逻辑问题-例如：

vQ > mnQ And vQ <= mxQ Or cbQ.Value = "" And _

应该是

((vQ > mnQ And vQ <= mxQ) Or cbQ.Value = "") And _

我会做这样的事情。个别测试速度更快，因为在任何失败的测试之后都无需继续检查

Sub Tester()

    Dim cbPr,cbTr,cbDn,cbk,cbQ,cbInj,cbInstr 'all variants
    Dim rw As Range,isMatch As Boolean,arrCrit

    'get combo boxes values
    cbPr = Trim(User_search.Cbx_Project_code.Value)
    cbTr = Trim(User_search.Cbx_TrueNOC.Value)
    cbDn = Trim(User_search.Cbx_DNAmass.Value)
    If Len(cbDn) > 0 Then cbDn = Split(cbDn,"-") 'convert to array
    cbk = Trim(User_search.Cbx_Kit.Value)
    cbQ = Trim(User_search.Cbx_QIndex.Value)
    If Len(cbQ) > 0 Then cbDn = Split(cbQ,"-")   'convert to array
    cbInj = Trim(User_search.Cbx_Injection_time.Value)
    cbInstr = Trim(User_search.Cbx_Instrument.Value)

    arrCrit = Array(2,cbPr,5,6,7,8,9,10,cbInstr)
    
    For i = 5 To shD.Range("B" & Rows.Count).End(xlUp).Row
        Set rw = shD.Rows(i)
        For n = LBound(arrCrit) To UBound(arrCrit) - 1 Step 2
            isMatch = CellIsMatch(rw.Cells(arrCrit(n)),arrCrit(n + 1))
            If Not isMatch Then Exit For
        Next n
        If isMatch Then rw.Copy shR.Cells(Rows.Count,1).End(xlUp).Offset(1,0)
    Next i
    
End Sub

'Does a cell value match the supplied criteria?
'  Criteria could be a range of two numeric values
Function CellIsMatch(cell As Range,crit) As Boolean
    Dim v
    v = cell.Value
    If Len(v) > 0 Then
        'is the criteria an array (range) ?
        If TypeName(crit) Like "*()" Then
            'assumes v is numeric
            CellIsMatch = (v > CDbl(Trim(crit(0))) And _
                           v < CDbl(Trim(crit(1))))
        Else
            CellIsMatch = (Trim(v) = crit) Or Len(crit) = 0
        End If
    End If
End Function