Excel中的单元格按字体颜色求和

Question

我在 Excel 中有一系列单元格，需要按其字体颜色求和。 A 列只是供应商的名称，显然是整个 5 月份：

理想情况下，我想知道此范围内黑色、红色或蓝色单元格的总和 所以我开发了两个场景，一个有宏，一个没有宏。

1. 没有 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 它就不起作用。

1. 使用 VBA

插入模块并创建这个公式，它自己起作用：

Function GetCellColor(ByVal Target As Range) As Integer
    GetCellColor = Target.Font.ColorIndex
End Function

使用下面的公式（如果它是数组公式，则给出错误）：

=SUM(IF(getcellcolor(B7:C16)=3,B7:C16,0))

*我可以编写手动遍历每个单元格并添加的代码，但我想知道每个场景的问题是什么......

Answer 1

正如 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 Function

Answer 2

您不能对多个单元格的范围执行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