|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 zsonline 于 2017-11-17 00:49 编辑
我在隔壁论坛看到一段代码,可以实现一个单元格内输入多个关键词,用空格隔开,查找到包含所有关键词的单元格。我想把这个功能套到另一个单关键词查找的代码里,实现多关键词查找。但是苦于看不懂代码,原附件又无法下载,只能求助高手了。多关键词查找代码
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$$B$$2" Then Exit Sub
Dim n&, Arr, i&, j&, y&
Dim Flag As Boolean
[b4:h16].ClearContents
aa = Split(Target.Value): n = 3
Arr = [b18].CurrentRegion
For i = 2 To UBound(Arr)
Flag = True
x = Join(Application.Index(Arr, i), "")
For y = 0 To UBound(aa)
If InStr(UCase(x), UCase(Trim(aa(y)))) = 0 Then Flag = False: Exit For
Next
If Flag = True Then
n = n + 1
Cells(i + 17, 2).Resize(1, UBound(Arr, 2)).Copy Cells(n, 2)
End If
Next
End Sub
现有单关键词查找代码
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$C$3" Then Exit Sub
If Target = "" Then Exit Sub
Dim Sht As Worksheet, Arr, i&, sb$, Brr(1 To 5000, 1 To 4), n&, j&
[b6].Resize(5000, 4).ClearContents
[b6].Resize(5000, 4).Borders.LineStyle = xlNone
sb = Target.Value
For Each Sht In Sheets
Arr = Sht.[a1].CurrentRegion
For i = 2 To UBound(Arr)
If InStr(Arr(i, 1), sb) Then
n = n + 1
For j = 1 To 4
Brr(n, j) = Arr(i, j)
Next
End If
Next
Next
If n >= 1 Then
[b6].Resize(n, 4) = Brr
[b6].Resize(n, 4).Borders.LineStyle = 1
Rows(6).Resize(n).RowHeight = 30
Else
MsgBox "没有此设备信息。"
End If
End Sub
单关键词查找表格(感谢蓝桥版主的帮助)
|
|