Помогите оптимизировать цикл

[FoxRiver]

Здравствуйте, в примере есть таблица. Необходимо суммировать значения строк диапазона в зависимости от цвета ячейки и результат вписывать в определенные ячейки данной строки.

Прошу помощи в оптимизации цикла в следующем коде:

Sub sumcolor()

Application.Volatile True
Dim i As Range
   For Each i In ThisWorkbook.Worksheets("Лист1").Range("B2:H2")
        If i.Interior.ColorIndex = 43 And i.Value <> "" And IsNumeric(i.Value) _
               Then Сумцвет = Сумцвет + i.Value
   Next
    ThisWorkbook.Worksheets("Лист1").Range("A2").Value = Сумцвет
    
   Сумцвет = 0
   
   For Each i In ThisWorkbook.Worksheets("Лист1").Range("B3:H3")
        If i.Interior.ColorIndex = 43 And i.Value <> "" And IsNumeric(i.Value) _
               Then Сумцвет = Сумцвет + i.Value
   Next
    ThisWorkbook.Worksheets("Лист1").Range("A3").Value = Сумцвет
    
    
    Сумцвет = 0
   
   For Each i In ThisWorkbook.Worksheets("Лист1").Range("B4:H4")
        If i.Interior.ColorIndex = 43 And i.Value <> "" And IsNumeric(i.Value) _
               Then Сумцвет = Сумцвет + i.Value
   Next
    ThisWorkbook.Worksheets("Лист1").Range("A4").Value = Сумцвет
    
    
End Sub

Не хочется писать данный код на каждую строку (строк в реальном документе больше ста). Помогите сделать цикл который после проверки первой строки суммировал данные в ячейке потом спускался на вторую строку и т.д.

[Hugo121]

Sub sumcolor()

   ' Application.Volatile True 'зачем?
    Dim i As Range, x&
    With ThisWorkbook.Worksheets("Лист1")
        For x = 2 To 14
            For Each i In .Range("B" & x & ":H" & x)
                If i.Interior.ColorIndex = 43 Then
                    If i.Value <> "" Then
                        If IsNumeric(i.Value) _
                           Then Сумцвет = Сумцвет + i.Value
                    End If
                End If
            Next
            .Range("A" & x).Value = Сумцвет: Сумцвет = 0
        Next
    End With
End Sub

Т.к. строк немного - думаю особо оптимизировать по скорости нужды нет. Но конечно есть где подкрутить...

[DiemonStar]

А не проще было использовать UDF?

[FoxRiver]

Hugo121 Огромное спасибо!

DiemonStar

Сообщение от DiemonStar

А не проще было использовать UDF?

К сожалению необходимо чтобы в ячейке где идет суммирование была возможность ручного ввода определенной цифры.

[DiemonStar]

ну тогда делаете так:

Public Function SumColor(ByRef Rng As Range)
  If Not Rng Is Nothing Then
    For Each El In Rng.Cells
      SumColor = SumColor + IIf(El.Interior.ColorIndex = 43, El.Value, 0)
    Next El
  Else
    SumColor = ""
  End If
End Function

Sub FillSum()
  For Each Rw In [A2:H14].Rows
    Rw.Cells(1, 1) = SumColor(Intersect([B:H], Rw))
  Next Rw
End Sub