我试图创建具有不同列复式条件的VBA COUNTIFS函数。我需要它只能算在E列有一个室内色彩的细胞,如果在C列相应的行具有特定的文本值。
例如:只算单元E10,如果C10的值为“TL”和E10拥有内饰颜色绿
我用这VBA代码来算的范围内,内饰颜色的细胞数量:
Function countif_by_color(rl As Range, r2 As Range) As Long
Application.Volatile
Dim x As Long
Dim cel As Range
x = 0
For Each cel In rl
If cel.Interior.color = r2.Interior.color Then
x = x + 1
End If
Next
countif_by_color = x
End Function
我一直在试图用这个公式(A13是颜色我想它来计算),使用它:
=(COUNTIFS($C$21:$C$101,"=TL",E21:E101,(countif_by_color(E21:E101,A13))))
但是,这实质上相当于在E列的绿色细胞从而改变COUNTIF标准与数值,而非彩色细胞计数一个数值。
我想改变countif_by_color功能VBA有多个标准像COUNTIFS功能....在此先感谢!
下面是一个使用countifs_by_color
接受可变数量范围的ParameterArray
UDF。注意:它不处理数组公式格式,COUNTIFS一样。如果你需要,它会需要修改。
Function countifs_by_color(ParamArray var() As Variant) As Variant
Application.Volatile
Dim criteria_range As Range
Dim criteria As Range
Dim cel As Range
Dim criteria_idx As Long
Dim critera_rows As Long
Dim critera_cols As Long
Dim result_no_match() As Boolean
Dim criteria_color As Variant
Dim cell_idx As Long
Dim match_count As Long
' must have even number of parameters
If ((UBound(var) - LBound(var)) Mod 2) = 0 Then GoTo InvalidParameters
'capture first range size
critera_rows = var(LBound(var)).Rows.Count
critera_cols = var(LBound(var)).Columns.Count
'must be one row or one column
If critera_rows <> 1 And critera_cols <> 1 Then GoTo InvalidParameters
'size array to capture matches
ReDim result_no_match(1 To IIf(critera_rows > 1, critera_rows, critera_cols)) 'initialises to all False
For criteria_idx = LBound(var) To UBound(var) Step 2
Set criteria_range = var(criteria_idx)
Set criteria = var(criteria_idx + 1)
'criteria must be single cell
If criteria.Count <> 1 Then GoTo InvalidParameters
'all criteria_rane must be same size
If criteria_range.Rows.Count <> critera_rows Or criteria_range.Columns.Count <> critera_cols Then GoTo InvalidParameters
'get color of criteria cell to avoid unnecassary sheet references
criteria_color = criteria.Interior.Color
'check each cell in criteria_range
For cell_idx = 1 To criteria_range.Cells.Count
'if cell has not already been invalidated
If Not result_no_match(cell_idx) Then
'compare colors
If criteria_range.Cells(cell_idx).Interior.Color <> criteria_color Then
'no match, invalidate cell
result_no_match(cell_idx) = True
End If
End If
Next
Next
'count matches
For cell_idx = LBound(result_no_match) To UBound(result_no_match)
If Not result_no_match(cell_idx) Then
match_count = match_count + 1
End If
Next
countifs_by_color = match_count
Exit Function
InvalidParameters:
countifs_by_color = CVErr(xlErrValue)
End Function
示例应用程序