基于行的单元格颜色行计算

Question

此代码根据单元格颜色进行计算 "green"。不幸的是，当它到达下一行时，例如row "E" (如图) 计算没有单独进行 e.g.仅适用于 C 行，但它采用 C 行中的值，如图所示。我怎样才能重写代码，使计算只一行一行地完成？

Sub Schaltfläche1_Klicken()
Dim wb As Workbook, wq As Object
Dim ws As Worksheet, datDatum
Dim cell As Range
Dim c As Long, r As Long, rng As Range

With Worksheets("Tabelle1")

For c = 3 To 5
    For r = 1 To 5
        If .Cells(r, c).DisplayFormat.Interior.Color = vbRed Then
            If rng Is Nothing Then
                Set rng = .Cells(r, c)
            Else
                Set rng = Union(rng, .Cells(r, c))
            End If
        End If
    Next r

 If Not rng Is Nothing Then _
        .Cells(8, c).Formula = "=average(" & rng.Address(0, 0) & ")"  
Next c
End With
End Sub

Answer 1

不太确定，如果我没听错的话，但我的理解是：计算单行中具有条件的单元格的平均值。因此，第 1 行有一个平均值，第 2 行有一个平均值...

这将是我的方法（很快就会根据你的方法）：

Sub Schaltfläche1_Klicken()
Dim wb As Workbook, wq As Object
Dim ws As Worksheet, datDatum
Dim cell As Range
Dim c As Long, r As Long, rng As Range

With Worksheets("Sheet1")

For c = 3 To 5
    For r = 1 To 5
        If .Cells(r, c).DisplayFormat.Interior.Color = vbRed Then
            If rng Is Nothing Then
                Set rng = .Cells(r, c)
            Else
                Set rng = Union(rng, .Cells(r, c))
            End If
        End If
        If Not rng Is Nothing Then _
        .Cells(8, c).formula = "=average(" & rng.Address(0, 0) & ")"

    Next r
Set rng = Nothing

Next c
End With
End Sub

Answer 2

如果我正确理解你的问题，你只需要在循环结束时重置你的rng。改变这个：

If Not rng Is Nothing Then _
        .Cells(8, c).Formula = "=average(" & rng.Address(0, 0) & ")"  
Next c
End With
End Sub

为此：

If Not rng Is Nothing Then _
        .Cells(8, c).Formula = "=average(" & rng.Address(0, 0) & ")"
        Set rng = Nothing
Next c
End With
End Sub

Answer 3

您必须在每次列迭代时将 rng 重新初始化为 Nothing

Sub Schaltfläche1_Klicken()
    Dim wb As Workbook, wq As Object
    Dim ws As Worksheet, datDatum
    Dim cell As Range
    Dim c As Long, r As Long, rng As Range

    With Worksheets("Tabelle1")
        For c = 3 To 5
            For r = 1 To 5
                If .Cells(r, c).DisplayFormat.Interior.Color = vbRed Then
                    If rng Is Nothing Then
                        Set rng = .Cells(r, c)
                    Else
                        Set rng = Union(rng, .Cells(r, c))
                    End If
                End If
            Next r

            If Not rng Is Nothing Then .Cells(8, c).Formula = "=average(" & rng.Address(0, 0) & ")"
            Set rng = Nothing ' re-initialize rng to nothing and get rid of cells gathered
        Next c
    End

基于行的单元格颜色行计算

Calculation based on cell colors row for row

excel

conditional

vba

colors

cell