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支持更多，當ColorIndex支持有限數量的顏色。但最有可能你的情況3不是red您嘗試匹配的顏色..

所以它必須是，

IF Cell.Interior.ColorIndex <> 3 then 

//count count 
End if 

我嘗試了你的子：有幾個問題。我已經把代碼放在旁邊了。請嘗試以下出。

1. 請使用Explicit reference for Ranges e.g.表（1）.Range it helps alot. So changed the way上次使用Row`被發現。
2. 你沒有設置colorD，它只有2行。因此，它改變爲， Set colorD = Sheets(2).Range("D2").Resize(endRow)
3. If在做與<>相反，所以改爲If Cell.Interior.ColorIndex = 3 Then
4. 甲錯字改成了M = M - redM

訂正代碼：

Option Explicit 

Sub countbyColourAndGender() 
    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 --HERE: it gave an error, so changed it.. 
    endRow = Sheets(2).Cells(Sheets(2).Rows.Count, "C").End(xlUp).Row 
    'Ensure ending row is at least Row 2 
    If endRow < 2 Then 
     endRow = 2 
    End If 

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

    'Set the applicable Column D range -- HERE: changed using `Resize` 
    Set colorD = Sheets(2).Range("D2").Resize(endRow) 
    'Loop through each cell in Column D 
    For Each Cell In colorD 
     If Cell.Interior.ColorIndex = 3 Then '-- HERE: not <> but = 
      'Red Cell found, get the cell value from Column C 
      cellVal = LCase(Cell.Offset(-1, -1).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 : HERE it has to subsctract not equal.. 
    M = M - redM 

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

輸出：

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 

我會評估你只計算一次，然後跟蹤紅細胞seperately（從遞減計數並根據需要）：

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