按单元格颜色统计数据，可以用这个函数

HI，大家好，我是星光。

最近有几个朋友询问一个相似的问题：如何按单元格填充色统计数据？

举个例子。如下图所示，A:B是数据源，B列有人工设置的单元格填充色。现在需要根据D列单元格的填充色，统计数量总和、颜色个数。

从数据规范性角度来说，通过单元格填充色来对数据进行分类是一个非常糟糕的选择，并不建议大家这样使用Excel。不过，有时候，你接手的就是这样一份表格，并且只能解决问题，而不能解决制造问题的那个人……

使用自定义函数GetRngColor可以实现按单元格填充色统计数据。

该函数有3个参数。第1个参数是数据源区域，第2个参数是统计依据单元格，第3个参数是统计方式，省略为求和，0为计数。

以下公式，可以按D2单元格的填充色统计B列相同填充色的值总和：

=GetRngColor(B$2:B$100,D2)

以下公式，可以按D2单元格的填充色统计B列相同填充色的值个数：

=GetRngColor(B$2:B$100,D2,1)

打个响指，该自定义函数的VBA代码如下：

代码看不全可以左右拖动

代码解析见注释..▼

'按单元格填充色统计数据'第1个参数是数据源区域'第2个参数是统计依据单元格'第3个参数指定计算方式，True为求和False为计数，默认为TrueFunction GetRngColor(ByVal rngData As Range, _ ByVal rngRef As Range, _ Optional ByVal rngColor As Boolean = True) _ As Variant Dim s As String, c As Range, vntSum As Variant, temp As Variant Application.Volatile True Set rngData = Intersect(rngData, rngData.Parent.UsedRange) '修正实际有效统计区域 s = rngRef.Interior.Color '获取第2参数的单元格填充色 For Each c In rngData '遍历数据源区域每个单元格 If c.Interior.Color = s Then '如果填充色相等 temp = c.Value If VBA.IsNumeric(temp) = False Then temp = 0 '判断是不是数值 If rngColor Then vntSum = vntSum + temp '累加求和 Else vntSum = vntSum + 1 '累加计数 End If End If Next GetRngColor = vntSum '函数名等于过程结果End Function

需要说明的是……

❶，该自定义函数对条件格式设置的单元格填充色统计无效——如果你的单元格填充色来源于条件格式，也没必要用这种方式来统计。把条件格式的公式取出，稍加修改即可用于条件求和与计数。

❷，修改单元格填充色并不会触发公式重算。换句话说，当单元格填充色发生了改变，需要按<F9>功能键强制公式重算，以便更新以上自定义函数的计算结果。

……

除此之外，还有一种比较少见的情况，按字体颜色统计数据，这里也一起分享了事。

举个例子，如下图所示，A:B是数据源，需要在E:F列分别统计D列字体颜色的合计值和总个数。

此时可以使用自定义函数GetFontColor。该函数的语法和GetRngColor的语法不能说相似，只能说一模一样。

根据D2单元格的字体颜色求和：

=GetFontColor(B$2:B$100,D2)

根据D2单元格的字体颜色计数：

=GetFontColor(B$2:B$100,D2,0)

该自定义函数的VBA代码如下：

代码看不全可以左右拖动

代码解析见注释..▼

'按单元格填充色统计数据'第1个参数是数据源区域'第2个参数是统计依据单元格'第3个参数指定计算方式，True为求和False为计数，默认为TrueFunction GetFontColor(ByVal rngData As Range, _                            ByVal rngRef As Range, _                            Optional ByVal rngColor As Boolean = True) _                            As Variant    Dim s As String, c As Range, vntSum As Variant, temp As Variant    Application.Volatile True    Set rngData = Intersect(rngData, rngData.Parent.UsedRange) '修正实际有效统计区域    s = rngRef.Font.Color '获取第2参数的单元格填充色    For Each c In rngData '遍历数据源区域每个单元格        If c.Font.Color = s Then '如果填充色相等            temp = c.Value            If VBA.IsNumeric(temp) = False Then temp = 0 '判断是不是数值            If rngColor Then                vntSum = vntSum + temp '累加求和            Else                vntSum = vntSum + 1 '累加计数            End If        End If    Next    GetFontColor = vntSum '函数名等于过程结果End Function