根据字体颜色对Excel中的单元格求和
根据字体颜色对Excel中的单元格求和
提问于 2018-06-07 03:41:16
我在Excel中有一个单元格范围，需要根据它们的字体颜色对它们求和。A栏只是供应商的名字，显然是整个5月份：
理想情况下，我想知道这个范围内黑色、红色或蓝色单元格的总和，所以我开发了两种情况，一种是有宏的，另一种是无宏的。
- without VBA
向红色和黑色单元格添加字符串，以了解它们是“不同的”，例如将268更改为268c，将66.5更改为66.5u，但保留52.96不变
并使用下面的数组公式：
{=SUM(IF(ISNUMBER(B7:C16),B7:C16,NUMBERVALUE(LEFT(B7:C16,3))))}这跳过了66.5中的.5，但是可以工作，并且一旦我将LEFT函数中的3(将单元格从文本截断为字符串)更改为LEN(B6:C17)-1，它就不能工作。
- with VBA
插入模块并创建此公式，该公式独立工作：
Function GetCellColor(ByVal Target As Range) As Integer
GetCellColor = Target.Font.ColorIndex
End Function使用下面的公式(如果它是数组公式或不是数组公式，则给出错误)：
=SUM(IF(getcellcolor(B7:C16)=3,B7:C16,0))*我可以编写代码，手动遍历每个单元格并添加，但我想知道每个场景的问题是什么……
回答 2
Stack Overflow用户
回答已采纳
发布于 2018-06-07 06:08:59
正如QHarr指出的那样，您不能在多单元格区域上使用Font.ColorIndex。
这是你的UDF的一个版本，它可以在你原来的工作表函数中工作：
Function GetCellColor(ByVal Target As Range)
Dim arr(), r As Long, c As Long
ReDim arr(1 To Target.Rows.Count, 1 To Target.Columns.Count)
For r = 1 To UBound(arr, 1)
For c = 1 To UBound(arr, 2)
arr(r, c) = Target(r, c).Font.ColorIndex
Next
Next
GetCellColor = arr
End FunctionStack Overflow用户
发布于 2018-06-07 04:24:34
不能对多个单元格的范围执行Target.Font.ColorIndex。使用更大的范围将产生null。
您可以在UDF中传入一个范围并循环求和。另外，将颜色作为参数传递给函数。
单色：
Public Function GetCellColor(ByRef Target As Range, ByVal targetColour As Long) As Long
Dim outValue As Long, currentcell As Range
For Each currentcell In Target.Cells
If currentcell.Font.ColorIndex = targetColour Then outValue = outValue + currentCell
Next currentcell
GetCellColor = outValue
End Function最多3色：
这可能需要改进，但如果使用最多3种颜色，最后2种颜色是可选的，并且每个颜色不应该多次传递，您可以尝试如下所示：
Public Function GetCellColor(ByRef Target As Range, ByVal targetColour As Long, Optional ByVal targetColour2 As Variant, Optional ByVal targetColour3 As Variant) As Long
Dim outValue As Long, currentcell As Range
Select Case True
Case Not IsMissing(targetColour2) And Not IsMissing(targetColour3)
If targetColour2 = targetColour3 Or targetColour = targetColour2 Or targetColour = targetColour3 Then GoTo earlyExit
Case IsMissing(targetColour2) And Not IsMissing(targetColour3)
If targetColour = targetColour3 Then GoTo earlyExit
Case Not IsMissing(targetColour2) And IsMissing(targetColour3)
If targetColour = targetColour2 Then GoTo earlyExit
End Select
For Each currentcell In Target.Cells
If currentcell.Font.ColorIndex = targetColour Then outValue = outValue + currentcell
If Not IsMissing(targetColour2) Then
If currentcell.Font.ColorIndex = targetColour2 Then
outValue = outValue + currentcell
End If
End If
If Not IsMissing(targetColour3) Then
If currentcell.Font.ColorIndex = targetColour3 Then
outValue = outValue + currentcell
End If
End If
Next currentcell
GetCellColor = outValue
Exit Function
earlyExit:
GetCellColor = CVErr(xlErrValue)
End Function页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/50728318
复制相关文章
相似问题