VBA学习笔记之利用查找颜色拾取进行颜色汇总

Posted 2020-10-06

教程代码：

 1 Sub 根据查找功能拾取的颜色求平均()
 2     On Error GoTo 100
 3   Dim erng As Range, rng As Range, i As Long
 4   i = Application.FindFormat.Interior.Color
 5   Set erng = Cells(Rows.Count, "e").End(xlUp)
 6   For Each rng In Range([b2], erng)
 7     If rng.Interior.Color = i Then k = k + rng.Value: n = n + 1
 8   Next
 9   MsgBox "最后平均分为：" & k / n & "分"
10   End
11 100:
12   MsgBox "查找功能没有拾取到颜色！"
13 End Sub

我认为缺点是有点麻烦，你先要用查找功能选择单元格样式，然后才能进行操作。我把它进行改进，直接选中区域就能操作。代码如下：

 1 Sub 自己写()
 2 ‘直接选择单个区域就可以执行
 3     On Error GoTo 100
 4 i = Selection.Interior.Color
 5 num = Application.CountA([a:a])
 6 For Each rng In Range("b2", Cells(num, "e"))
 7     If rng.Interior.Color = i Then
 8     k = k + rng.Value
 9     n = n + 1
10     End If
11     Next
12   MsgBox "最后平均分为：" & k / n & "分"
13   End
14 100:
15   MsgBox "请选择单个区域!"
16 End Sub