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

如果在另一个区域中的对应单元格具有正确的值标准，我正在计算与参考单元格具有相同颜色的区域中的单元格数量。 例如：

如果（A1 <350）和（B1与参考单元具有相同的颜色），则计数为1.循环遍历行1至15

这与本文发布的问题基本相同：
http://www.mrexcel.com/forum/excel-questions/58582-countif-multiple-criteria-one-being-interior-color.html

不幸的是，ExtCell.zip文件似乎不再退出。 因此，我不能简单地复制给定的解决scheme。 我尝试使用SUMPRODUCT函数遵循相同的方法，并且编写了一个比较单元格颜色的函数，但是它不起作用。 我得到了错误“公式中使用的值是错误的数据types。 我的代码如下。 我在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

代码中有几个问题

1. 您需要确定compareCells的大小，而不是调用者单元格
2. 你正在考虑的专栏，应该是行（或行和列最大的灵活性）
3. 你可以做一些优化

这里是你的函数的重构版本

 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