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函数遵循相同的方法，并且我编写了一个用于比较单元格颜色的函数，但它不起作用。我收到了错误＆＃34;公式中使用的值是错误的数据类型。＆＃34;我的代码如下。我在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的大小，而不是来电小区
您正在考虑列，应该是行（或行和列以获得最大的灵活性）
您可以进行一些优化

这是您的功能的重构版本

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列传递给它宽 - 就像你的样本公式一样。

Answer 2

尝试（针对给定的公式进行更新：=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

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

2 个答案: