问题描述
我有一个带有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