Excel·VBA单元格区域按颜色求和等计算

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

举例