将一组数中最大三个值所在单元格填充红色

lanshijitian

如图1行3行分别为两组数据，如何用VBA进行编写 采用Large函数选出最大的三个值所对应的单个单元，并将单元格填充为红色？

lanshijitian

相同数字也计算在内，如 67 ，55， 89， 43 ，98 ，43 ，90 ，34 ，65 ， 90
头三个最大数是98 90 90，则将这三个数所在单元格填充红色

roych

条件格式

如果是2003班则需要写公式

lanshijitian

roych 发表于 2016-5-12 15:09
条件格式

如果是2003班则需要写公式

谢谢解答！
如果采用VBA代码呢？因为条件格式有一定的局限性（或许有其他的方法而我不知道）。
采用条件格式会出现图中上面情况，它会将相同的数值都填充，三组最大值全都填充了
需要达成的为：无论有几个相同的最大值，只让它显示三个最大的填充，而其余的相同值不填充。

roych

lanshijitian 发表于 2016-5-12 20:12
谢谢解答！
如果采用VBA代码呢？因为条件格式有一定的局限性（或许有其他的方法而我不知道）。
采用条 ...

那怎么判断哪三个是最大的？这又没有排序什么的。

lanshijitian

经过几天尝试，写了一组代码，请各位老师看看，参考附

1. Public j, i
   
2. 
   
3. Private Sub 刷新_Click()
   
4. Range("A1:M1").Select
   
5.     With Selection.Interior
   
6.         .Pattern = xlSolid
   
7.         .PatternColorIndex = xlAutomatic
   
8.         .ThemeColor = xlThemeColorDark1
   
9.         .TintAndShade = 0
   
10.         .PatternTintAndShade = 0
    
11.     End With                               '将数值区填充恢复无色
    
12. For x = 1 To 13
    
13.    Cells(1, x) = Application.WorksheetFunction.RandBetween(1, 100)
    
14. Next
    
15. End Sub
    
16. 
    
17. Private Sub 显示3个最大值_Click()
    
18.   j = 0
    
19.   i = 0
    
20.     arr = Range(Cells(1, 1), Cells(1, 13))
    
21.     A = Application.WorksheetFunction.Large(arr, 1)   'A B C 为每行最大三个
    
22.     B = Application.WorksheetFunction.Large(arr, 2)
    
23.     C = Application.WorksheetFunction.Large(arr, 3)
    
24.     If A > B Then
    
25.         Call XH(A)
    
26.         Call XH(B)
    
27.          If B > C Then
    
28.            Call XH(C)
    
29.          End If
    
30.     Else
    
31.         Call XH(A)
    
32.         If B > C Then
    
33.            Call XH(C)
    
34.         End If
    
35.     End If
    
36. End Sub
    
37. Sub XH(A)                 '最大三个数值填充红色
    
38. For y = 1 To 13
    
39.      If j < 3 Then
    
40.         If Cells(1, y) = A Then
    
41.            Cells(1, y).Select
    
42.            With Selection.Interior
    
43.               .Pattern = xlSolid
    
44.               .PatternColorIndex = xlAutomatic
    
45.               .Color = 255
    
46.               .TintAndShade = 0
    
47.               .PatternTintAndShade = 0
    
48.            End With
    
49.            j = j + 1
    
50.         End If
    
51.       End If
    
52. Next
    
53. End Sub
    

复制代码

件