[已解决]行自动查找显示。

wolun

行 自动查找显示。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-2-16 07:58

行列通用：按行选定，按行填充底色；按列选定，按列填充底色

跳转到最佳答案楼层

dsmch

1. Private Sub Worksheet_selectionChange(ByVal Target As Range)
   
2. Dim arr, d, m As Range, rng As Range
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("b4").CurrentRegion
   
5. Sheet1.UsedRange.Interior.ColorIndex = xlNone
   
6. If Target.Count > 1 And Target.Count < 8 Then
   
7.     x = Target.Count
   
8.     For Each m In Target
   
9.         d(m.Value) = d(m.Value) + 1
   
10.     Next
    
11.     a = d.keys: b = d.items:
    
12.     For j = 1 To UBound(arr, 2)
    
13.         For i = 1 To UBound(arr) - x + 1
    
14.             s = 0
    
15.             For k = 0 To d.Count - 1
    
16.                 If Application.CountIf(Cells(i + 3, j + 1).Resize(1, x), a(k)) = b(k) Then s = s + 1 Else GoTo line1
    
17.             Next
    
18.             If s = d.Count Then Cells(i + 3, j + 1).Resize(1, x).Interior.ColorIndex = 3
    
19. line1:
    
20.         Next
    
21.     Next
    
22. End If
    
23. End Sub
    

复制代码

dsmch

和列查找代码差不多

dsmch

行列通用：按行选定，按行填充底色；按列选定，按列填充底色

wolun

dsmch 发表于 2014-2-16 07:58
行列通用：按行选定，按行填充底色；按列选定，按列填充底色

太强大了，老师。
我试着把这段代码改成像先前老师那样与选取的数据完全一样的显示红色底，没有改成功，我真是太笨了。

dsmch

wolun 发表于 2014-2-16 11:27
太强大了，老师。
我试着把这段代码改成像先前老师那样与选取的数据完全一样的显示红色底，没有改成功， ...

在原来的帖子给你修改一下，行列通用，顺序相同。