Цикл, который захватывает стоимость определенных предметов, а затем добавляет все найденные значения

Question

Мне нужна помощь в создании цикла для моей следующей проблемы.

У меня есть список элементов в столбце K, а их значения в столбце L.

Что я хочу сделать, это:

Для каждой ячейки в столбце K, содержащей "Item1", возьмите ее значение и добавьте все найденные значения.

Я пытаюсь сделать это без необходимости вставлять все значения, найденные в столбце N, а затем складывать их.

Ниже мой код.

Sub Test()

    Dim rng As Range, cell As Range

    Set rng = Range("K1:K10")

    For Each cell In rng
        cell.Activate
        Val1 = cell.Value
        If Val1 = "Item1" Then
            Val2 = ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Value
            If Sheets("Sheet1").Range("N1") = "" Then
                Sheets("Sheet1").Range("N1") = Val2
            Else
                Sheets("Sheet1").Range("N33").End(xlUp).Offset(1) = Val2
            End If
        Else
        End If
    Next cell

    Range("N11").Activate
    ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"

End sub

Answer 1

РЕДАКТИРОВАТЬ:

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

Sub Test()

    Dim rng As Range, cell As Range
    Dim Val1 As Variant
    Dim Sum As Double: Sum = 0

    Set rng = Range("K1:K10")

    For Each cell In rng
        Val1 = cell.Value
        If Val1 = "Item1" Then
            Sum = Sum + cell.Offset(rowOffset:=0, columnOffset:=1).Value
        End If
    Next cell

    Range("N11").Value2 = Sum

End Sub

---

Из оригинального ответа:

Одно из действительно важных золотых правил, которое вам нужно узнать о программировании на VBA, - это никогда не использовать Activate и ActiveCell.

Я реорганизовал ваш код, чтобы показать, как это сделать (плюс продемонстрировать еще несколько советов):

Sub Test()

    Dim cell As Range
    For Each cell In Range("K1:K10")
        Dim Val1 As Variant
        Val1 = cell.Value2
        If Val1 = "Item1" Then
            Dim Val2 As Variant
            Val2 = cell.Offset(rowOffset:=0, columnOffset:=1).Value2
            If Sheets("Sheet1").Range("N1") = "" Then
                Sheets("Sheet1").Range("N1") = Val2
            Else
                Sheets("Sheet1").Range("N33").End(xlUp).Offset(1) = Val2
            End If
        End If
    Next cell

    Range("N11").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"

End Sub

Итак, эта строка:

Val2 = ActiveCell.Offset(rowOffset:=0, ColumnOffset:=1).Value

Изменения в:

Val2 = cell.Offset(rowOffset:=0, ColumnOffset:=1).Value

Или лучше:

Val2 = cell.Offset(ColumnOffset:=1).Value2