VBA，COUNTIF，基于单元格颜色排除

Question

我正在尝试计算C列中“M”和“F”的数量，但不包括D列（同一行）中的单元格内部颜色为红色的情况。该脚本计算每个“M”和“F”的个案数，但不排除小区D为红色的任何情况。有什么想法吗？

Private Sub Workbook_Open()
Dim F As Long
Dim M As Long
Dim colorD As Range
Dim Cell As Range


F = Range("C" & Rows.count).End(xlUp).Row
M = Range("C" & Rows.count).End(xlUp).Row
Set colorD = Range("D" & Rows.count).End(xlUp)


If F < 2 Then F = 2
If M < 2 Then M = 2


For Each Cell In colorD
   If Cell.Interior.Color <> 3 Then
   F = Application.WorksheetFunction.CountIf(Range("C2:C" & F), "F")
   M = Application.WorksheetFunction.CountIf(Range("C2:C" & M), "M")
   End If
Next Cell

MsgBox ("Females=" & F & "," & "Males=" & M)


End Sub

Answer 1

你能否对此进行调试打印，以查看单元格colourIndex是否真的3

Debug.Print Cell.Interior.ColorIndex 

由于，

Cell.Interior.Color需要RGB才能匹配...您只需要.ColorIndex匹配;）要非常精确Color支持更多{{1}支持有限数量的颜色。但在您的情况下，ColorIndex很可能不是您要匹配的3颜色。

所以必须如此，

red

我尝试了你的潜艇：几个问题。我已经在代码中添加了注释。请尝试以下方法。

1. 请使用IF Cell.Interior.ColorIndex <> 3 then //count count End if 表格（1）。找到了Explicit reference for Ranges e.g.上次使用的行“。
2. 您没有设置it helps alot. So changed the way，它只有2行。所以改成了，     colorD
3. Set colorD = Sheets(2).Range("D2").Resize(endRow)与If正好相反，因此将其更改为<>
4. 拼写错误将其更改为If Cell.Interior.ColorIndex = 3 Then

修订代码：

M = M - redM

输出：

Answer 2

我认为问题在于，您要重新评估颜色为不红色的每个单元格的计数，而不是递减它们。

For Each Cell In colorD
    If Cell.Interior.Color <> 3 Then
        'Here you are re-evaluating F, not incrementing it.
        F = Application.WorksheetFunction.CountIf(Range("C2:C" & F), "F")
        'And the same for M.
        M = Application.WorksheetFunction.CountIf(Range("C2:C" & M), "M")
    End If
Next Cell

我只评估你的计数一次，然后单独跟踪红细胞（根据需要将它们从计数中减少）：

Private Sub Workbook_Open()
    Dim endRow As Long
    Dim redF As Long
    Dim redM As Long
    Dim F As Long
    Dim M As Long
    Dim colorD As Range
    Dim Cell As Range
    Dim cellVal As String

    'Find the ending row
    endRow = Range("C" & Rows.Count).End(xlUp).endRow
    'Ensure ending row is at least Row 2
    If endRow < 2 Then
        endRow = 2
    End If

    'Count all the Females
    F = Application.WorksheetFunction.CountIf(Range("C2:C" & endRow), "F")
    'Count all the Males
    M = Application.WorksheetFunction.CountIf(Range("C2:C" & endRow), "M")

    'Set the applicable Column D range
    Set colorD = Range("D2", Range("D" & Rows.Count).End(xlUp))
    'Loop through each cell in Column D
    For Each Cell In colorD
        If Cell.Interior.ColorIndex = 3 Then
            'Red Cell found, get the cell value from Column C
            cellVal = LCase(Cell.Offset(-1, 0).Value)
            If cellVal = "f" Then redF = redF + 1 'Increment count of red Females
            If cellVal = "m" Then redM = redM + 1 'Increment count of red Males
        End If
    Next Cell

    'Subtract any red Females
    F = F - redF
    'Subtract any red Males
    M = M = redM

    'Alert User with counts
    MsgBox ("Females=" & F & "," & "Males=" & M)
End Sub