Сохранить промежуточное значение переменной во время выполнения цикла

[karlos67]

Доброго времени суток! Прошу помощи в решении задачи.
Есть таблица из двух колонок: код товара и количество. Необходимо просуммировать количествово товаров по разным группам кодов.
В примере 4 группы товаров: группа 1 (товары с кодами 1, 2, 4, 9), группа 2 (125, 554, 335) и т.д.
Внес каждую группу кодов товаров в отдельный массив (spisok1-4), а все списки кодов в общий массив списков кодов (spisok_list). Сделал 2 цикла. Внешний перебирает списки кодов, внутренний – коды внутри каждого списка. Строка MsgBox summ последовательно выводит на экран сумму товаров по каждому из 4-х списков кодов, но после каждого цикла значение summ обнуляется.

Вопрос: можно ли как-нибудь сохранить промежуточное значение summ во время работы цикла, например присвоить его какой-нибудь назначаемой в процессе работы цикла переменной? Нужно чтобы после окончания работы цикла все 4 значения суммы (по каждой группе кодов товара) были доступны и к ним можно было обращаться (например summ1, summ2, summ3, summ4).

Код Выделить Развернуть

Sub viborka()
spisok1 = Array(1, 2, 4, 9) 'делаю 4 списка с перечнями кодов товаров
spisok2 = Array(125, 554, 335)
spisok3 = Array(88, 22, 77, 55)
spisok4 = Array(2, 4, 18, 22, 28, 46, 64, 74, 88, 554)
spisok_list = Array(spisok1, spisok2, spisok3, spisok4) 'делаю перечень списков с кодами товаров

LastRow = Cells(Rows.Count, 1).End(xlUp).Row   'определение конца списка
summ = 0

For Each spisok In spisok_list 'внешний цикл -перебираю перечни списков с кодами товаров
i = 2
summ = 0
For Each kod In spisok 'внутренний цикл -перебираю коды внутри каждого списка
1:
 If kod = Worksheets("Лист1").Cells(i, 1).Value Then
    summ = summ + Worksheets("Лист1").Cells(i, 2).Value
    GoTo 2
 Else
    i = i + 1
     If i > LastRow Then
       GoTo 2
     End If
    GoTo 1
 End If
  GoTo 1
2:
  i = 2
Next kod
MsgBox summ 'сумма товаров по каждому списку
Next spisok
End Sub

[Poltava]

Объявите массив с количеством элементов как в масисве spisok_list и присваивайте i-му элементу ему значение summ

[karlos67]

Что-то я не догоняю...

Фуу... вроде дошло...

Sub viborka()
spisok1 = Array(1, 2, 4, 9)
spisok2 = Array(125, 554, 335)
spisok3 = Array(88, 22, 77, 55)
spisok4 = Array(2, 4, 18, 22, 28, 46, 64, 74, 88, 554)
spisok_list = Array(spisok1, spisok2, spisok3, spisok4)
Dim summ_n(3)
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
summ = 0
j = -1
For Each spisok In spisok_list
j = j + 1
i = 2
summ = 0
For Each kod In spisok
1:
  If kod = Worksheets("Лист1").Cells(i, 1).Value Then
     summ = summ + Worksheets("Лист1").Cells(i, 2).Value
     GoTo 2
  Else
     i = i + 1
      If i > LastRow Then
        GoTo 2
      End If
     GoTo 1
  End If
   GoTo 1
2:
   i = 2
Next kod
summ_n(j) = summ
Next spisok
End Sub

[karlos67]

А подскажите еще плиз.
Можно ли сделать, чтобы программа брала списки кодов для суммирования из листа Excel (например из именованных диапазонов)? Чтобы можно было править их на листе, а не менять каждый раз в тексте программы.

[Poltava]

Код Выделить Развернуть

Function GetList(RangeName As String)
        Dim tCell As Object
        Dim i&, arr() As Integer
        ReDim arr(Range(RangeName).Count - 1)
        i = 0 ': Count = 0
        For Each tCell In Range(RangeName)
        If Not IsNumeric(tCell.Value) Then GoTo lable1
        arr(i) = tCell.Value
        i = i + 1
lable1:
        Next tCell
        ReDim Preserve arr(i - 1)
        GetList = arr
End Function

Скармливайте этой процедуре имена диапазонов и она переберет все ячейки в них входящие и вернет массив их значений пропуская текстовые.
И есче всегда используйте Option Explicit в начале модуля потому как отказ от явного обьявления переменных похож на ходьбу по минному полю без миноискателя.
Dim summ_n(3) а всегда ли будет три обьявите так summ_n(UBound(spisok_list))

[karlos67]

Спасибо! Про Option Explicit как раз сегодня утром прочитал. Уже использую.