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

薛定谔_51

已于 2022-06-01 21:23:02 修改

阅读量2.8k

点赞数 1

分类专栏： # Excel VBA 文章标签： excel vba

于 2022-05-06 14:14:44 首次发布

本文链接：https://blog.csdn.net/hhhhh_51/article/details/124609142

版权

Excel 同时被 2 个专栏收录

79 篇文章 74 订阅

订阅专栏

VBA

76 篇文章 27 订阅

订阅专栏

本文介绍了两个Excel自定义函数，用于按单元格颜色进行特定计算。第一个函数`color_calc`实现了按颜色求和、计数、求平均值和最值，适用于不同范围的数据。第二个函数`color_sumequal`则检查区域内颜色相同的单元格其数值之和是否相等，返回TRUE或FALSE。这两个函数扩展了Excel的常规功能，为数据处理提供了更多可能性。

摘要由CSDN通过智能技术生成

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