基本的函数在你的文件中都过不了,仅供参考
Sub 查询()
Dim ar As Variant
Dim br()
Dim bm
Dim mc
Dim xz
ar = Sheets("工程明细单").[a1].CurrentRegion
ReDim br(1 To UBound(ar), 1 To 5)
With Sheets("工程装框查询")
bm = .[c1]
mc = .[e1]
xz = .[i2]
If bm = "" Or mc = "" Then MsgBox "请输入查询条件": Exit Sub
If xz = "" Then MsgBox "请输入匹配规则条件": Exit Sub
If Trim(xz) = "精准" Then
For I = 2 To UBound(ar)
If Trim(ar(I, 28)) = Trim(bm) And Trim(ar(I, 27)) = Trim(mc) Then
r = r + 1
br(r, 1) = r
br(r, 2) = ar(I, 1)
br(r, 3) = ar(I, 4)
br(r, 4) = ar(I, 27)
br(r, 5) = ar(I, 2)
End If
Next I
ElseIf Trim(xz) = "模糊" Then
For I = 2 To UBound(ar)
If InStr(ar(I, 28), bm) > 0 And InStr(ar(I, 27), mc) > 0 Then
r = r + 1
br(r, 1) = r
br(r, 2) = ar(I, 1)
br(r, 3) = ar(I, 4)
br(r, 4) = ar(I, 27)
br(r, 5) = ar(I, 2)
End If
Next I
End If
If r = "" Then MsgBox "没有符合条件的数据": Exit Sub
.[a1].curretregion.Offset(2) = Empty
.[a3].Resize(r, UBound(br, 2)) = br
End With
End Sub
|