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

[Igor67]

2 Hugo
Наверное было бы лучше еще и проверку через несколько If делать.
В вашем случае, даже если первое условие не выполняется, два последующих все равно проверятся
If a(i, 1) = b(1, k + 2) And a(i, 2) = b(r, 1) And a(i, 3) = b(r, 2) Then b(r, k + 2) = b(r, k + 2) + a(i, 5)

For k = 1 To 12
For r = 2 To bb
For i = 1 To aa
If a(i, 1) = b(1, k + 2) then
If a(i, 2) = b(r, 1) then
if a(i, 3) = b(r, 2) Then b(r, k + 2) = b(r, k + 2) + a(i, 5)
end if
end if
Next
Next
Next

[Hugo121]

Да, спасибо, что-то мне и в голову не пришло А результат-то существенный, в 2 раза (напомню - анализируем и суммируем данные из 65499 рядов):

6,515625
7,34375
7,46875
7,0625
7,359375
7,46875

3,53125
3,09375
3,3125
3,3125
3,3125
3,375

P.S.Только сейчас дошло - так ведь так мы сделали ADO! На целую секунду!

[kipish_lp]

А если я заполняю:

For k = 10 to 34 Step 2

и

 rrng = Array(5,10,15)
For Each r in rrng

У меня с такими параметрами че-то не получается.

[Hugo121]

Ничего не понял

[kipish_lp]

Приношу свои извинения.
У меня цикл для обработки столбцов с шагом, напр., 2, и определенные строки, куда ставить данные.

For k = 10 to 34 Step 2
rrng = Array(5,10,15)
For Each r in rrng
For i = 1 To aa
If a(i, 1) = b(1, k + 2) then
If a(i, 2) = b(r, 1) then
if a(i, 3) = b(r, 2) Then b(r, k + 2) = b(r, k + 2) + a(i, 5)
end if
end if
Next
Next
Next

Если использовать массив, вставляются всякие данные подряд. А как к моим условиям переделать, я пока не догадываюсь.

[Hugo121]

For k = 10 to 34 Step 2 - перебираем названия месяцев
If a(i, 1) = b(1, k + 2) then - если название месяца в таблице совпадает с названием месяца из списка, т.е. надо синхронизировать элемент массива b, из которого берёте значения.
Вообще так без примера трудно с уверенностью сказать, где проскакивает ошибка. Прогоните через F8 и в окне Locals смотрите, какие значения в массивах, что сравнивается и что суммируется.

[kipish_lp]

Вот, что у меня получилось. Не пойму, в чем дело.
И еще, не пойму как сделать строки, напр, 22, 24, 27.

[Hugo121]

Там почти уже сошлось, основная ошибка была в расположении выгрузки массива. В архиве есть скрин сравнения кодов, если интересно.
Да, и k надо перебирать с 1, там ведь в начале халаты/перчатки в этом массиве надо сравнить
Но если делать, как я в начале, на 3-4 массивах, тогда проще алгоритм построить - месяцы в одном массиве, халаты/перчатки в другом, выгружаем в третий. Поанализируйте тот код.

Насчёт "строки 22,24,27" - вот весь код. Добавил массив значений цикла rrng, как у Вас выше было. Ещё пришлось заменить определение r.
Строки в явном виде не указываются, указываются элементы массива, в которых содержатся значения этих строк.
А вообще наверное это можно и формулами сделать. На таком объёме сработают, вот на 65500 будет тормозить. Но я не формулист

Sub Sobrat2()
'Dim tm 'это я время считал
'tm = Timer 'это я время считал
Dim ash As Worksheet
Dim a(), b()
Dim i As Long, k As Long, aa As Long, bb As Long, r
Dim rrng()

Set ash = ThisWorkbook.Sheets(1)
ash.Range("i21:af27").Value = "" 'обнуляем, если надо суммировать - можно закомментировать
a = ash.Range("A2:e42").Value 'база данных всего, вместо 65500 можно переменную
b = ash.Range("g20:af27").Value  'база сводной - что ищем и куда грузим
aa = UBound(a)
'bb = UBound(b) 'это не нужно, если rrng перебираем
rrng = Array(3, 5, 8) ' это элементы массива, на листе это строки 22,24,27

For k = 1 To 24 Step 2
    For Each r In rrng
'    For r = 1 To bb 'это не нужно, если rrng перебираем
        For i = 1 To aa
        If a(i, 1) = b(1, k + 2) Then
        If a(i, 2) = b(r, 1) Then
        If a(i, 3) = b(r, 2) Then b(r, k + 2) = b(r, k + 2) + a(i, 5)
        End If
        End If
        Next
    Next
Next

ash.Range("g20:af27") = b

'Debug.Print Timer - tm 'это я время считал
End Sub

[kipish_lp]

Спасибо огромное!
А можно еще вопрос. Как сделать так, чтобы во всем массиве изменялись только нужные ячейки, а остальные данные (у меня, к примеру, формулы) не трогались. Сейчас они все заменяются на значения.

[Hugo121]

Это меняет дело. Легко не получится, в этом подходе тогда надо делать выборочную выгрузку полученного массива на лист - выгружать не всё, а только в те ячейки, которые подсчитывались. Т.е. вместо одной строки ash.Range("g20:af27") = b надо делать цикл по массиву и выгружать на лист выбранные элементы, а не сразу всё.
Это муторно, попробуйте сами. Только Вы знаете, где эти формулы
Ну и очистку тогда тоже делать надо выборочно, не затирая формулы.
Это если формулы в области сводной.