如何用vba根据条件查找到目标数据并标记颜色

YZC51 · 发表于 2020-3-14 09:08

zhenhao1989 发表于 2020-3-14 08:11
谢谢大神,但现在有个新的请求,不知能否实现,就是当"物料代码"那列有多个内容和B2相似时,请把它们筛选出来 ...

Sub 解除筛选()
ActiveSheet.Range("$B$7:$B$21").AutoFilter Field:=1
End Sub

shenjianrong163 · 发表于 2020-3-14 14:58

zhenhao1989 发表于 2020-3-14 08:11
谢谢大神,但现在有个新的请求,不知能否实现,就是当"物料代码"那列有多个内容和B2相似时,请把它们筛选出来 ...

Sub test()
Dim i, k, m, d, num, arr
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
num = .[B2].Value
arr = .UsedRange
For i = 8 To UBound(arr)
If InStr(arr(i, 2), num) > 0 Then
m = 1
d(arr(i, 2)) = arr(i, 2)
End If
Next
k = d.Keys
If m = 1 Then
.Range(Cells(7, 1), Cells(UBound(arr, 1) + 1, UBound(arr, 2))).AutoFilter 2, k, Operator:=xlFilterValues '对查到的值进行筛选
Else
MsgBox "没有找到！"
End If
End With
End Sub
Sub DelFilter()
Dim arr
With Sheets("Sheet1")
arr = .UsedRange
.Range(Cells(7, 1), Cells(UBound(arr, 1) + 1, UBound(arr, 2))).AutoFilter '取消筛选
End With
End Sub

复制代码

shenjianrong163 · 发表于 2020-3-14 15:02

zhenhao1989 发表于 2020-3-14 08:11
谢谢大神,但现在有个新的请求,不知能否实现,就是当"物料代码"那列有多个内容和B2相似时,请把它们筛选出来 ...

请参考附件：

料表.rar (11.25 KB, 下载次数: 55)

zhenhao1989 · 发表于 2020-3-16 13:38

shenjianrong163 发表于 2020-3-14 15:02
请参考附件：

大佬,这个好像有点小问题,就是找到唯一相似的时候没有标记颜色了.... 然后能不能再加个提示,就是当查找的内容已经标记黄色了,弹出提示框说"已查找过" 非常谢谢!!!

shenjianrong163 · 发表于 2020-3-17 22:14

zhenhao1989 发表于 2020-3-16 13:38
大佬,这个好像有点小问题,就是找到唯一相似的时候没有标记颜色了.... 然后能不能再加个提示,就是当查找 ...

Sub test()
Dim i, k, m, d, num, arr
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
num = .[B2].Value
arr = .UsedRange
For i = 8 To UBound(arr)
If InStr(arr(i, 2), num) > 0 Then
If .Range(Cells(i, 1), Cells(i, UBound(arr, 2))).Interior.Color = vbYellow Then
MsgBox "已查找过！"
Exit Sub
Else
.Range(Cells(i, 1), Cells(i, UBound(arr, 2))).Interior.Color = vbYellow
End If
m = 1
d(arr(i, 2)) = arr(i, 2)
End If
Next
k = d.Keys
If m = 1 Then
.Range(Cells(7, 1), Cells(UBound(arr, 1) + 1, UBound(arr, 2))).AutoFilter 2, k, Operator:=xlFilterValues '对查到的值进行筛选
Else
MsgBox "没有找到！"
End If
End With
End Sub
Sub DelFilter()
Dim arr
With Sheets("Sheet1")
arr = .UsedRange
.Range(Cells(7, 1), Cells(UBound(arr, 1) + 1, UBound(arr, 2))).AutoFilter '取消筛选
End With
End Sub

复制代码

shenjianrong163 · 发表于 2020-3-17 22:16

zhenhao1989 发表于 2020-3-16 13:38
大佬,这个好像有点小问题,就是找到唯一相似的时候没有标记颜色了.... 然后能不能再加个提示,就是当查找 ...

请参考附件：

料表.rar (11.31 KB, 下载次数: 4)

		自动登录	找回密码
密码			免费注册

[求助] 如何用vba根据条件查找到目标数据并标记颜色