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

セルの colorIndex が実際に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.Sheets(1).Range it helps alot. So changed the wayLast Used Row` を使用してください。
  2. を設定しておらず、colorD2 行しかありませんでした。それで、それを次のように変更しました。 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 に答える