Question

我正在尝试创建一个在不同列中具有互斥条件的vba countifs函数。如果C列中的相应行具有特定的文本值，则只需要计算E列中具有内部颜色的单元格即可。

例如：如果C10的值为“ TL”且E10的内部颜色为绿色，则仅计数单元格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_by_color函数VBA更改为具有countifs函数之类的多个条件。...在此先感谢！

Answer 1

这是一个countifs_by_color UDF，它使用ParameterArray来接受可变数量的范围。注意：它不像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

示例应用程序

具有文本和内部颜色标准的Countifs

1 个答案: