按颜色对单元格求和的功能

Question

下面我放置了一个函数代码来按颜色对单元格求和。我写了一个 sub 来执行这个函数。

我收到运行时“1004”错误。我不知道是什么部分导致了错误。我看不到问题。

    Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
    Dim rCell As Range
    Dim lCol As Long
    Dim vResult

    lCol = rColor.Interior.ColorIndex

    If SUM = True Then
        For Each rCell In rRange
            If rCell.Interior.ColorIndex = lCol Then
                vResult = WorksheetFunction.SUM(rCell, vResult)
            End If
        Next rCell
    Else
        For Each rCell In rRange
            If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
            End If
        Next rCell
    End If

    ColorFunction = vResult
    End Function

    Sub sumbycolor()

    NextRow = Range("B" & Rows.Count).End(xlUp).Row + 9
    Range("B" & NextRow).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    Dim lr As Long, critRange As String, sumRange As String
    lr = Cells(Rows.Count, "O").End(xlUp).Row
    sumRange = Range("O2:O" & lr).Address

    CellColor = Range("B" & Rows.Count).End(xlUp).Row + 9

    NextRow = Range("C" & Rows.Count).End(xlUp).Row + 9
    Range("C" & NextRow).Select
    ActiveCell.FormulaR1C1 = "=ColorFunction(" & CellColor & "," & sumRange & ",TRUE)"

    End Sub

Answer 1

我整理了一个代码 sn-p，其中包含我在 cmets 中提到的对您的问题的更改。为了便于调试，我创建了一个字符串来保存公式。

...
Dim lr As Long, critRange As String, sumRange As String
Dim intCellColorRow As Integer
Dim strCellColorRange As String
Dim strFormula As String

lr = Cells(Rows.Count, "O").End(xlUp).Row
sumRange = Range("O2:O" & lr).Address

intCellColorRow = Range("B" & Rows.Count).End(xlUp).Row + 9
strCellColorRange = Range("B" & intCellColorRow).Address

NextRow = Range("C" & Rows.Count).End(xlUp).Row + 9
Range("C" & NextRow).Select
strFormula = "=ColorFunction(" & strCellColorRange & "," & sumRange & ",TRUE)"
ActiveCell.Formula = strFormula
...