|
Sub 模糊查询()
Range("d3:i65536").ClearContents '清除当前所有查询内容
Application.ScreenUpdating = False '停止刷新
Dim arr, brr(1 To 3000, 1 To 20), i&, s&, sh As Worksheet, bb '定义两个二维数组,3个工作表,1个变量
If OptionButton1 = True Then bb = 2 '姓名
If OptionButton2 = True Then bb = 3 '部门
If OptionButton3 = True Then bb = 8 '邮箱
If OptionButton4 = True Then bb = 5 '手机号码
w = [b3] '定义w为输入关键字的值
For Each sh In Worksheets
If sh.Name = "Sheet1" Then
arr = sh.UsedRange '选取Sheet1中的单元格
For i = 2 To UBound(arr) '从第二行直到Sheet1最后一行进行操作
If w = "" Then GoTo 100 '输入关键字为空则返回所有记录
If InStr(arr(i, bb), w) > 0 Then '如果Sheet1中某一单元格的值包含输入关键字的值执行以下操作
100
s = s + 1 '计算返回记录的数量
brr(s, 1) = arr(i, 2)
brr(s, 2) = arr(i, 3)
brr(s, 3) = arr(i, 4)
brr(s, 4) = arr(i, 5)
brr(s, 5) = arr(i, 1)
brr(s, 6) = arr(i, 8)
'将数组arr正在查询的该行中的姓名、部门、办公电话、手机、地址、外网邮箱写入brr数组
End If
Next
End If
Next
[c3] = s 'C3单元格返回查询记录数量
If s = 0 Then MsgBox w & " 不在查询范围内!": End '如果查询记录数量为0则显示“ 不在查询范围内!”
Range("d3").Resize(s, 6) = brr '将brr输入填入D3至I65536
Application.ScreenUpdating = True '刷新
End Sub
|
|