Расчет на основе цвета ячеек строки для строки - PullRequest
Новая
       35

Расчет на основе цвета ячеек строки для строки

0 голосов
/ 11 сентября 2018

Этот код выполняет расчеты на основе цвета ячейки "зеленый". К сожалению, когда он попадает в следующий ряд, например в строке «E» (как на рисунке) расчет не производится отдельно, например, только для строки C, но она принимает значения в строке C, как показано на рисунке. Как я могу переписать код таким образом, чтобы вычисление выполнялось только для строки?

enter image description here

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

Ответы [ 3 ]

0 голосов
/ 11 сентября 2018

Если я правильно понимаю ваш вопрос, вам просто нужно сбросить 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
0 голосов
/ 11 сентября 2018

вы должны повторно инициализировать 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
0 голосов
/ 11 сентября 2018

Не совсем уверен, правильно ли я вас понял, но я понял следующее: посчитайте среднее количество ячеек с критериями в одной строке.Поэтому у вас есть одно среднее значение в ряду 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
...