如何按单元格颜色求和？VBA函数与宏的修改及使用咨询

原函数作用 #

原IsCellColored是返回横向数组的函数，数组内每个元素对应输入区域的单元格是否有填充色——True代表有色，False代表无色。

直接修改函数实现求和 #

如果想让函数直接输出有色单元格的求和结果，改写成以下代码即可：

Function SumColoredCells(CellRange As Range) As Double
    Application.Volatile
    Dim total As Double
    Dim rCell As Range
    
    total = 0
    For Each rCell In CellRange
        If rCell.Interior.ColorIndex <> xlNone Then
            total = total + rCell.Value
        End If
    Next rCell
    
    SumColoredCells = total
End Function

使用时直接在D1单元格输入公式：=SumColoredCells(B2:B&Cells(Rows.Count,"B").End(xlUp).Row)，无论区域内是否有有色单元格，结果都符合要求——有则返回求和值，无则返回0。

保留原函数用公式求和 #

若不想修改原函数，也可以用数组公式（Excel 365/2021直接回车，旧版本需按Ctrl+Shift+Enter）：
=SUMPRODUCT(--IsCellColored(B2:B&Cells(Rows.Count,"B").End(xlUp).Row), B2:B&Cells(Rows.Count,"B").End(xlUp).Row)
原理是用--把布尔值转换为1或0，再和对应单元格的值相乘后求和，无有色单元格时结果自动为0。

你编写的宏存在两个关键问题：

1. 宏的参数ws As Worksheet和循环For Each ws In ActiveWorkbook.Worksheets冲突，遍历工作表时会出错；
2. 变量v在循环外初始化，会累计所有工作表的求和值，无法实现每个工作表单独计算。

修正后的宏代码：

Public Sub sumBasedOnColor()
    Dim ws As Worksheet
    Dim rg As Range
    Dim v As Double
    Dim c As Range
    
    For Each ws In ActiveWorkbook.Worksheets
        v = 0 ' 每个工作表单独初始化求和值
        With ws
            Set rg = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
        End With
        
        For Each c In rg
            If c.Interior.ColorIndex <> xlNone Then
                v = v + c.Value
            End If
        Next
        
        ws.Range("D1") = v
    Next ws
End Sub

额外调整：将v的类型从Single改为Double，避免小数计算时的精度丢失问题。

内容的提问来源于stack exchange，提问作者JeffCh