Excel VBA：CountIf（值标准）AND（颜色标准）

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 函数遵循相同的方法，并编写了一个用于比较单元格颜色的函数，但它没有用。我收到错误 "A value used in the formula is of the wrong data type." 我的代码如下。我在 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

试试这个 （针对给定公式更新：=SUMPRODUCT((B57:B65<350) * (ColorCompare(D307,D57:D65)))）：

Sub test()
i = 57
While Not IsEmpty(Cells(i, 1))
If Cells(i, 2) < 350 And Cells(i, 4).Interior.ColorIndex = Cells(307, 4).Interior.ColorIndex Then 'replace with your reference cell
count = count + 1
End If
i = i + 1
Wend
End Sub

Answer 2

您的代码中存在几个问题

您需要确定 compareCells 的大小，而不是调用方单元格
您正在考虑列，应该是行（或行和列以获得最大的灵活性）
您可以进行一些优化

这是您的函数的重构版本

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

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

Excel VBA：CountIf（值标准）AND（颜色标准）

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

excel

vba