0

我正在尝试计算 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
4

2 回答 2

1

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

Debug.Print Cell.Interior.ColorIndex

因为，

Cell.Interior.Color需要 aRGB来匹配...你只需要.ColorIndex匹配 ;) 非常准确地说，当支持有限数量的颜色Color时支持更多。ColorIndex但在您的情况下，最有可能3不是red您要匹配的颜色。

所以它必须是，

IF Cell.Interior.ColorIndex <> 3 then

//count count
End if

我试过你的潜艇：有几个问题。我在代码旁边放了注释。请尝试以下方法。

  1. 请使用Explicit reference for Ranges e.g.Sheets(1).Range it helps alot. So changed the wayLast Used 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

输出：

在此处输入图像描述

于 2013-01-08T18:38:45.983 回答
0

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

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
于 2013-01-08T19:00:56.850 回答