Excel模块 – VBA：如果满足条件，则计算彩色单元格的函数

人！

我不经常在Excel中提到VBA，但是当我这样做的时候，我通过谷歌searchfind了答案。 但是，我目前的需求是没有答案的。

我有以下函数来计算范围内的颜色（可能的来源 – http://www.ozgrid.com/VBA/sum-count-cells-by-color.htm ）：

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.Color If SUM = True Then For Each rCell In rRange If rCell.Interior.Color = lCol Then vResult = WorksheetFunction.SUM(rCell) End If Next rCell Else For Each rCell In rRange If rCell.Interior.Color = lCol Then vResult = 1 + vResult End If Next rCell End If ColorFunction = vResult End Function 

如果满足条件，我试图将其扩展到特定范围的颜色数，但是失败。

亲爱的同事们，请你们帮助我扩大function以满足需要：

如果在另一个范围内符合单词“foo”，则计数特定范围内的颜色数量 。

Answer 1

根据你的post，你要Count的彩色单元格的数量，所以我做了下面的修改你的Function工作，因为你张贴。

StrCond是第三个参数，它是Optional以检查rCell.Value的某个String 。

 Function ColorFunction(rColor As Range, rRange As Range, Optional StrCond As String) As Long Dim rCell As Range Dim lCol As Long Dim vResult As Long lCol = rColor.Interior.color For Each rCell In rRange If rCell.Interior.color = lCol Then If StrCond <> "" Then If rCell.Value = StrCond Then vResult = vResult + 1 End If Else vResult = vResult + 1 End If End If Next rCell ColorFunction = vResult End Function 

testing完成后的单元格值的屏幕截图 Function ：

在没有第三个参数的情况下testing这个Function之后的单元格值的屏幕截图 （如预期的那样得到5 ）：

Answer 2

让我们从这样的事情开始：

 Option Explicit Function ColorFunction(rColor As Range, rRange As Range) As Long Dim rCell As Range Dim lCol As Long Dim bFooMet As Boolean Dim lResult As Long lCol = rColor.Interior.Color For Each rCell In rRange If rCell.Interior.Color = lCol Then lResult = lResult + 1 If rCell.value = "foo" Then bFooMet = True Next rCell If bFooMet Then ColorFunction = lResult Else ColorFunction = -1 End If End Function 

如果你的activesheet看起来像这样：

你可以在即时窗口中input?ColorFunction(cells(1,1),selection) ，就可以得到11的结果 – 黄色单元格的数目，与A1背景相同。

如果在所选范围内没有foo ，则会得到-1 。

如果你只想用里面的foo计算yellow单元格，可能是这样的：

 Option Explicit Function ColorFunction(rColor As Range, rRange As Range) As Long Dim rCell As Range Dim lCol As Long Dim bFooMet As Boolean Dim lResult As Long lCol = rColor.Interior.Color For Each rCell In rRange If rCell.value = "foo" And rCell.Interior.Color = lCol Then lResult = lResult + 1 End If Next rCell ColorFunction = lResult End Function 

Answer 3

由于Shai Rado的解决scheme，我可以修改脚本，以便它需要两个范围：第一个为所需的彩色单元格，第二个为所需的单词。 该脚本是：

  Function ConditionalColorFunction(rColor As Range, rColoredRange As Range, StrCond As String, rCondRange As Range) As Long Dim rColoredCell As Range Dim lCol As Long Dim i As Integer Dim iCondRangeColumnsAmount As Integer Dim vResult lCol = rColor.Interior.Color iCondRangeColumnsAmount = rCondRange.Columns.Count For Each rColoredCell In rColoredRange If rColoredCell.Interior.Color = lCol Then For i = 1 To iCondRangeColumnsAmount If Cells(rColoredCell.Row, i).Value = StrCond Then vResult = 1 + vResult Exit For End If Next End If Next rColoredCell ConditionalColorFunction = vResult End Function 

rColor – 具有所需颜色的单元格。

rColoredRange – 与不同颜色的单元格的范围。

StrCond – 所需的单词。

rCondRange – 具有不同单词的单元格的范围。