基于单元格颜色逐行计算答案

【问题标题】：Calculation based on cell colors row for row基于单元格颜色逐行计算
【发布时间】：2019-02-15 13:49:12
【问题描述】：

此代码根据单元格颜色“绿色”进行计算。不幸的是，当它到达下一行时，例如“E”行（如图所示）计算不是单独进行的，例如仅适用于 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

【问题讨论】：

为编辑干杯

标签： excel vba colors conditional cell

【解决方案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

【讨论】：

【解决方案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

【讨论】：

DisplayName 答案很好。 prextor 和 Kirszu（实际上是相同的）的答案更适合。说真的，感谢您的帮助和努力，非常感谢

【解决方案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

【讨论】：