=GetRngColor(B$2:B$100,D2)
=GetRngColor(B$2:B$100,D2,1)
'按单元格填充色统计数据
'第1个参数是数据源区域
'第2个参数是统计依据单元格
'第3个参数指定计算方式,True为求和False为计数,默认为True
Function 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
=GetFontColor(B$2:B$100,D2)
=GetFontColor(B$2:B$100,D2,0)
'按单元格填充色统计数据
'第1个参数是数据源区域
'第2个参数是统计依据单元格
'第3个参数指定计算方式,True为求和False为计数,默认为True
Function 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
联系客服