Excel·VBA单元格区域按颜色求和等计算
1,单元格区域按颜色求和、计数、求平均值、最值2,单元格区域按颜色和值是否相等
·
1,单元格区域按颜色求和、计数、求平均值、最值
Function color_calc(rng As Range, rng_color As Range, Optional mode As String = "s")
'函数定义color_calc(求和区域,指定颜色单元格,模式)对区域中符合指定颜色的值进行计算
'5种模式,"s"即求和sum、"a"即平均值average、"c"即计数count、"max"即最大值、"min"即最小值
'单个单元格、单行、单列、多行多列都适用
Dim rc, r, i&, arr
ReDim arr(1 To rng.count)
rc = rng_color.Interior.Color
i = 0
For Each r In rng
If r.Interior.Color = rc Then
i = i + 1
arr(i) = CDbl(r.Value)
End If
Next
ReDim Preserve arr(1 To i)
If LCase(mode) = "s" Then
color_calc = WorksheetFunction.Sum(arr)
ElseIf LCase(mode) = "a" Then
color_calc = WorksheetFunction.Average(arr)
ElseIf LCase(mode) = "c" Then
color_calc = i
ElseIf LCase(mode) = "max" Then
color_calc = WorksheetFunction.Max(arr)
ElseIf LCase(mode) = "min" Then
color_calc = WorksheetFunction.Min(arr)
End If
End Function
举例
2,单元格区域按颜色和值是否相等
Function color_sumequal(rng As Range)
'函数定义color_sumequal(求和区域)对求和区域按颜色求和,返回颜色的和是否相等TRUE/FALSE
'单个单元格、单行、单列、多行多列都适用
Dim dict, rc, r, v, i
Set dict = CreateObject("scripting.dictionary")
For Each r In rng
rc = r.Interior.Color
dict(rc) = dict(rc) + r.Value
Next
v = dict.Items
For i = 1 To dict.count - 1: '遍历字典
If v(i) <> v(0) Then color_sumequal = "FALSE": Exit Function
Next
color_sumequal = "TRUE"
End Function
举例

DAMO开发者矩阵,由阿里巴巴达摩院和中国互联网协会联合发起,致力于探讨最前沿的技术趋势与应用成果,搭建高质量的交流与分享平台,推动技术创新与产业应用链接,围绕“人工智能与新型计算”构建开放共享的开发者生态。
更多推荐
所有评论(0)