Перенос данных по таблицам с группировкой

[artemiyiva]

Нужна помощь!
Помогите сделать макрос, всю голову сломал, ошибку в чтении критериев выдает, есть болванка, нужно доработать:

Sub ПереносДанных()

Dim A, D As Integer
For D = 5 To 2283
For A = 5 To 1911
If Cells(A, 2) = Cells(D, 18) And Cells(A, 3) = Cells(D, 19) And Cells(A, 4) = Cells(D, 20) And Cells(A, 5) = Cells(D, 21) And Cells(A, 6) = Cells(D, 22) And Cells(A, 7) = Cells(D, 23) Then
Cells(A, 11) = Cells(A, 11) + Cells(D, 24)
Cells(A, 12) = Cells(A, 12) + Cells(D, 25)
Cells(D, 26) = "A"
Cells(D, 27) = "B"
End If
Next A
Next D
End Sub

Необходимо по данным таблицы "А" по столбцам А,D,E,F найти такие же в таблице "В" по столбцам A1, D1, E1, F1 суммировать суммы одинаковых по R и подставить в столбец "1"

[EducatedFool]

Файл выкладывайте.

Зачем макрос - чем не устраивают формулы?
Какую ошибку выдаёт ваш макрос?
Наверное, на одной из этих строк:

Cells(A, 11) = Cells(A, 11) + Cells(D, 24)
Cells(A, 12) = Cells(A, 12) + Cells(D, 25)

Попробуйте так:

Sub ПереносДанных()
    Dim A As Integer, D As Integer: Application.ScreenUpdating = False
    For D = 5 To 2283
        For A = 5 To 1911
            If Cells(A, 2) = Cells(D, 18) And Cells(A, 3) = Cells(D, 19) _
               And Cells(A, 4) = Cells(D, 20) And Cells(A, 5) = Cells(D, 21) _
               And Cells(A, 6) = Cells(D, 22) And Cells(A, 7) = Cells(D, 23) Then
                Cells(A, 11) = Val(Cells(A, 11)) + Val(Cells(D, 24))
                Cells(A, 12) = Val(Cells(A, 12)) + Val(Cells(D, 25))
                Cells(D, 26) = "A": Cells(D, 27) = "B"
            End If
        Next A
    Next D
End Sub

[artemiyiva]

C загрузкой таблицы какие-то проблемы...

Нет, ошибку выдает на:
If Cells(A, 2) = Cells(D, 18) And Cells(A, 3) = Cells(D, 19) And Cells(A, 4) = Cells(D, 20) And Cells(A, 5) = Cells(D, 21) And Cells(A, 6) = Cells(D, 22) And Cells(A, 7) = Cells(D, 23) Then

По идее здесь должны быть несколько показателей:

If Cells(A, 4) = Cells(А1, 4) And Cells(D, 4) = Cells(D1, 4) And Cells(E, 4) = Cells(E1, 4) And Cells(F, 4) = Cells(F1, 4) Then

Так понимаю это условие, а следущую формулу я вообще не понимаю;

Cells(A, 11) = Cells(A, 11) + Cells(D, 24)
Cells(A, 12) = Cells(A, 12) + Cells(D, 25)

Тут должен быть свод при выполнении условия

[EducatedFool]

C загрузкой таблицы какие-то проблемы...

Не, пожалуй, тут проблема скорее в неверном подходе к решению задачи...

Хотите получить готовое решение, или, по крайней мере, рекомендации по его осуществлению?
Тогда перечитайте это:

Файл выкладывайте.
Зачем макрос - чем не устраивают формулы?

[artemiyiva]

Формулы - это замечательно, если бы можно было, я бы в макросы не лез. Пытался через Промежуточные итоги сделать, а потом ВПРом подставить, но условия по нескольким столбцам, не вариант, он мне по первому только ставит.

[vikttur]

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

Формулы - это замечательно, если бы можно было...

Попытка №3:

Файл выкладывайте.

[Hugo121]

И вообще, имхо тут тоже надо делать на массивах, как http://www.programmersforum.ru/showt...=108262&page=2, чувствую, что задача похожа. Будет отрабатывать за доли секунды.

[artemiyiva]

Вот таблица, наконец-то получилось выложить