|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 核对()
Dim r&, r1&, k&, k1& '声明变量
Dim s$, s1$
Dim Arr(), Brr() '声明数组变量
Dim Rng As Range
Dim ds As Object
Set ds = CreateObject("Scripting.Dictionary") '定义字典
r = Range("a1048576").End(xlUp).Row
Arr = Range("a1:b" & r).Value '将单元格数据装入数组
r1 = Range("h1048576").End(xlUp).Row
Brr = Range("h1:i" & r1).Value
Range("a:b").Interior.ColorIndex = 0
For k1 = 1 To r1
For c1 = 1 To 2
If Brr(k1, c1) <> "" Then ds(CStr(Brr(k1, c1))) = "" '将数组的值装入字典(供下一步查询)
Next
Next
For k = 1 To r
For c = 1 To 2
If ds.exists(Mid(Cells(k, c), 2, 3)) Then '如果字典中存在指定的值(三位数)
If Rng Is Nothing Then
Set Rng = Cells(k, c) '将单元格保存到变量Rng
Else
Set Rng = Union(Rng, Cells(k, c)) '将单元格合并到变量Rng
End If
End If
Next c
Next k
If Rng Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Rng.Interior.ColorIndex = 3 '给单元格(区域)填充颜色
Application.ScreenUpdating = True
End Sub
|
评分
-
2
查看全部评分
-
|