Question

此代码基于单元格颜色“绿色”进行计算。不幸的是，当它到达下一行时行“ 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

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

基于单元格颜色的计算

3 个答案: