Office中国论坛/Access中国论坛

标题: 将一组数中最大三个值所在单元格填充红色 [打印本页]
作者: lanshijitian    时间: 2016-5-12 11:25
标题: 将一组数中最大三个值所在单元格填充红色
如图1行3行分别为两组数据，如何用VBA进行编写 采用Large函数选出最大的三个值所对应的单个单元，并将单元格填充为红色？
作者: lanshijitian    时间: 2016-5-12 11:35
相同数字也计算在内，如 67 ，55， 89， 43 ，98 ，43 ，90 ，34 ，65 ， 90
头三个最大数是98 90 90，则将这三个数所在单元格填充红色
作者: roych    时间: 2016-5-12 15:09
条件格式
[attach]59021[/attach]
如果是2003班则需要写公式
作者: lanshijitian    时间: 2016-5-12 20:12
roych 发表于 2016-5-12 15:09
条件格式

如果是2003班则需要写公式

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

那怎么判断哪三个是最大的？这又没有排序什么的。
作者: lanshijitian    时间: 2016-5-17 09:12
经过几天尝试，写了一组代码，请各位老师看看，参考附
  1. Public j, i

  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

  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
复制代码
件



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3