vba - Excel VBA : CountIf (value criterion) AND (color criterion)

Question

我正在尝试计算与引用单元格颜色相同的范围内的单元格数量，如果另一个范围内的相应单元格具有正确的值标准。例如:

如果 (A1 < 350) 和 (B1 与引用单元具有相同的颜色)，则计数 1。
循环第 1 到 15 行

这与此处发布的问题本质上是相同的问题:
http://www.mrexcel.com/forum/excel-questions/58582-countif-multiple-criteria-one-being-interior-color.html

不幸的是，ExtCell.zip 文件似乎不再退出。因此，我不能简单地复制给定的解决方案。我尝试使用 SUMPRODUCT 遵循相同的方法函数，我写了一个比较单元格颜色的函数，但它不起作用。我收到错误“公式中使用的值的数据类型错误。”我的代码如下。我在 Windows 7 上使用 Excel 2007。感谢任何帮助。谢谢!

=SUMPRODUCT((B57:B65<350) * (ColorCompare(D307,D57:D65)))   

上面的公式被键入到一个单元格中。 B57:B65包含一些数值，而 D57:D65是彩色细胞。 D307是具有正确颜色的引用单元格。

'' VBA function ColorCompare
Function ColorCompare(refCell As Range, compareCells As Range) As Variant
    Dim rCell As Range
    Dim TFresponses() As Boolean     'the boolean array to be returned to SUMPRODUCT

    Dim CallerCols As Long     'find out the number of cells input by the user 
                               'so as to define the correct array size
    With Application.Caller
        CallerCols = .Column.Count
    End With
    ReDim TFresponses(1 To CallerCols)

    Dim Idx As Long
    Idx = 1
    For Each rCell In compareCells
        If rCell.Interior.ColorIndex = refCell.Interior.ColorIndex Then
            TFresponses(Idx) = 1
            Idx = Idx + 1
        Else
            TFresponses(Idx) = 0
            Idx = Idx + 1
        End If
    Next rCell

    ColorCompare = TFresponses

End Function

Answer 1

您的代码中有几个问题

您需要确定 compareCells 的大小，而不是调用方单元格

您正在考虑列，应该是行(或行和列以获得最大的灵 active )

您可以进行一些优化

这是您的函数的重构版本

Function ColorCompare(refCell As Range, compareCells As Range) As Variant
    Dim rCell As Range, rRw As Range
    Dim TFresponses() As Boolean     'the boolean array to be returned to SUMPRODUCT
    Dim rw As Long, cl As Long
    Dim clr As Variant

    clr = refCell.Interior.ColorIndex
    ReDim TFresponses(1 To compareCells.Rows.Count, 1 To compareCells.Columns.Count)

    rw = 1
    For Each rRw In compareCells.Rows
        cl = 1
        For Each rCell In rRw.Cells
            If rCell.Interior.ColorIndex = clr Then
                TFresponses(rw, cl) = True
            End If
            cl = cl + 1
        Next rCell
        rw = rw + 1
    Next rRw
    ColorCompare = TFresponses
End Function

请注意，虽然这将返回任何形状范围的结果，但在 SumProduct 中很有用传递一个 1 行高或 1 列宽的范围 - 就像您的示例公式一样。