[已解决]请教各位vba高手帮助 查找多条件相同的问题

qhllqhll

c列 和 f列里 查找
（c列为物品，f列为单价 ）查找物品名和单价完全相同的  ，查出来后对应的行和单元格变灰色
也就是在同一行里 ，在c列和f列里，找相同行的物品和单价相同的 变色

例如：c5=2 ，f5=6
如果：c8=2，f8=6
则对应的底色变成灰色

谢谢
见附件
附件.rar (1.51 KB, 下载次数: 30)

2011-12-15 16:34 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

蓝桥玄霜

2011-12-15 21:11

1. Sub yy()
   
2. Application.ScreenUpdating = False
   
3. Dim Arr, d, k, t, x$
   
4. Dim i%, j%, aa
   
5.     Set d = CreateObject("Scripting.dictionary")
   
6.     Arr = Range("c5:f15")
   
7.     For i = 1 To UBound(Arr)
   
8.         If Arr(i, 1) <> "" And Arr(i, 4) <> "" Then
   
9.             x = Arr(i, 1) & "|" & Arr(i, 4)
   
10.             d(x) = d(x) & i & ","
    
11.         End If
    
12.     Next
    
13.     k = d.keys
    
14.     t = d.items
    
15.     For i = 0 To UBound(k)
    
16.         t(i) = Left(t(i), Len(t(i)) - 1)
    
17.         If InStr(t(i), ",") Then
    
18.             aa = Split(t(i), ",")
    
19.             For j = 0 To UBound(aa)
    
20.                 Cells(aa(j) + 4, 3).Interior.ColorIndex = 6
    
21.                 Cells(aa(j) + 4, 6).Interior.ColorIndex = 6
    
22.             Next
    
23.         End If
    
24.     Next
    
25. Application.ScreenUpdating = True
    
26. End Sub

复制代码

跳转到最佳答案楼层

蓝桥玄霜

1. Sub yy()
   
2. Application.ScreenUpdating = False
   
3. Dim Arr, d, k, t, x$
   
4. Dim i%, j%, aa
   
5.     Set d = CreateObject("Scripting.dictionary")
   
6.     Arr = Range("c5:f15")
   
7.     For i = 1 To UBound(Arr)
   
8.         If Arr(i, 1) <> "" And Arr(i, 4) <> "" Then
   
9.             x = Arr(i, 1) & "|" & Arr(i, 4)
   
10.             d(x) = d(x) & i & ","
    
11.         End If
    
12.     Next
    
13.     k = d.keys
    
14.     t = d.items
    
15.     For i = 0 To UBound(k)
    
16.         t(i) = Left(t(i), Len(t(i)) - 1)
    
17.         If InStr(t(i), ",") Then
    
18.             aa = Split(t(i), ",")
    
19.             For j = 0 To UBound(aa)
    
20.                 Cells(aa(j) + 4, 3).Interior.ColorIndex = 6
    
21.                 Cells(aa(j) + 4, 6).Interior.ColorIndex = 6
    
22.             Next
    
23.         End If
    
24.     Next
    
25. Application.ScreenUpdating = True
    
26. End Sub

复制代码

qhllqhll

蓝桥玄霜 发表于 2011-12-15 21:11

非常感谢 蓝版主 蓝恩师
您总是能解最难的 难题
您的答案最准确 最正确
谢谢