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

[kipish_lp]

Здравствуйте! Подскажите, пожалуйста, как можно оптимизировать макрос, который находится в примере. Надо просуммировать данные по определенным параметрам, и вывести их в нужные ячейки. Что макрос и делает. Но когда строк около 10000, а таблица, которую надо заполнить очень большая, макрос выполняется очень долго.
Скажу сразу, про сводные таблицы знаю, работать научилась, данные получать тоже, но иногда она не подходит. Поэтому прошу помощи с данным макросом.

[аналитика]

небольшая коррекция
можно привлечь встроенные средства Excel (СУММЕСЛИ напр.)

[kipish_lp]

Суммесли - это хорошо, но когда данные берутся из другой книги, не очень удобно, постоянно обновлять надо. И если более 2000 строк очень долго пересчет происходит. Про накопитель значений - косяк, недосмотрела. А так макрос все равно медленно работает, он каждый раз все строки прогоняет заново.

[doober]

Убедился уже много раз.что для обработки такого количества строк очень удобно использовать АДО.На примере данных в 50 000 строк отработал менее 2 секунд.Имя листа с данными должно быть Лист1,под себя внесете исправления.
Единственный минус-месяцы идут по алфавиту.Если бы был формат даты -тогда без проблем. Я думаю проще столбцы потом поменять.

[Hugo121]

Я в последнее время массивы использую почаще. Вроде и код прозрачный, и быстро работают.
Вот этот код на диапазоне A2:E65500 отработал за 6.5 секунд.
Легко поменять всё под другие диапазоны. Файл тот же исходный, только данные вниз размножил.

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

Set ash = ThisWorkbook.ActiveSheet
ash.Range("i2:t7").Value = "" 'обнуляем, если надо суммировать - можно закомментировать
a = ash.Range("A2:e65500").Value 'база данных всего, вместо 65500 можно переменную
b = ash.Range("g2:h7").Value 'база сводной - что ищем
c = ash.Range("i1:t1").Value 'месяцы
d = ash.Range("i2:t7").Value 'диапазон выгрузки
aa = UBound(a)
bb = UBound(b)

For k = 1 To 12
    For r = 1 To bb
        For i = 1 To aa
        If a(i, 1) = c(1, k) And a(i, 2) = b(r, 1) And a(i, 3) = b(r, 2) Then d(r, k) = d(r, k) + a(i, 5)
        Next
    Next
Next

ash.Range("i2:t7") = d

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

[Hugo121]

To doober - на моей машине ADO обошёл массивы всего на 2 секунды (время открытия файла не учитывал, только время работы Shet path, "Лист1").
А как же Перчатки 1/2/3?
И расположение... И код сложнее.
Я за массивы!

[alexvav]

Сообщение от аналитика

небольшая коррекция
можно привлечь встроенные средства Excel (СУММЕСЛИ напр.)

подскажите, как вы внесли формулу с фигурными скобками? в смысле, что это за формула такая?

[doober]

А я в последнее время ближе к базам и SQL.Да действительно в перчатках не правильный результат.если число сохранить как текст-работает правильно

[аналитика]

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

подскажите, как вы внесли формулу с фигурными скобками? в смысле, что это за формула такая?

это формула массива
вводится Ctrl+Shift+Enter

[Hugo121]

Я тут подумал, и убрал один массив, правда работать особо быстрее не стало, и код проще не стал. Но всёж... Хотя можно и ещё один массив убрать...
Вот, вместо 4 массивов оставил 2. Особо быстрее работать не стало, может на пару сотых секунды.

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

Set ash = ThisWorkbook.Sheets(1)
ash.Range("i2:t7").Value = "" 'обнуляем, если надо суммировать - можно закомментировать
a = ash.Range("A2:e65500").Value 'база данных всего, вместо 65500 можно переменную
b = ash.Range("g1:t7").Value 'база сводной - что ищем и куда грузим
aa = UBound(a)
bb = UBound(b)

For k = 1 To 12
    For r = 2 To bb
        For i = 1 To aa
        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)
        Next
    Next
Next

ash.Range("g1:t7") = b

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