Оптимизировать код макроса

[manowar_gub]

Подскажите как можно оптимизировать код макроса, считает ооочень долго...

For x = 5 To 42 'строка в сводном 8213
    Sheets("Сводный").Cells(x, 3).Value = 0
    For z = 2 To 1000 'строка в кредхистори
    If Sheets("Сводный").Cells(x, 2).Value <> Empty And _
    Sheets("Сводный").Cells(x, 2).Value = Sheets("KredHistory").Cells(z, 13).Value Then _
    Sheets("Сводный").Cells(x, 3).Value = Sheets("Сводный").Cells(x, 3).Value + Sheets("KredHistory").Cells(z, 4).Value
    Next z

    Sheets("Сводный").Cells(x, 4).Value = 0 'столбец А
    Sheets("Сводный").Cells(x, 5).Value = 0 'столбец Б
    Sheets("Сводный").Cells(x, 6).Value = 0 'столбец В
    Sheets("Сводный").Cells(x, 7).Value = 0 'столбец Г
    
    For y = 2 To 10000 'строка в кредхистори
        If Sheets("Сводный").Cells(x, 2).Value <> Empty And Sheets("Сводный").Cells(x, 2).Value = Sheets("Реестр").Cells(y, 42).Value And Sheets("Реестр").Cells(y, 19).Value <> "Ипотечный" And Sheets("Реестр").Cells(y, 16).Value = "А" Then Sheets("Сводный").Cells(x, 4).Value = Sheets("Сводный").Cells(x, 4).Value + 1
        If Sheets("Сводный").Cells(x, 2).Value <> Empty And Sheets("Сводный").Cells(x, 2).Value = Sheets("Реестр").Cells(y, 42).Value And Sheets("Реестр").Cells(y, 19).Value <> "Ипотечный" And Sheets("Реестр").Cells(y, 16).Value = "Б" Then Sheets("Сводный").Cells(x, 5).Value = Sheets("Сводный").Cells(x, 5).Value + 1
        If Sheets("Сводный").Cells(x, 2).Value <> Empty And Sheets("Сводный").Cells(x, 2).Value = Sheets("Реестр").Cells(y, 42).Value And Sheets("Реестр").Cells(y, 19).Value <> "Ипотечный" And Sheets("Реестр").Cells(y, 16).Value = "В" Then Sheets("Сводный").Cells(x, 6).Value = Sheets("Сводный").Cells(x, 6).Value + 1
        If Sheets("Сводный").Cells(x, 2).Value <> Empty And Sheets("Сводный").Cells(x, 2).Value = Sheets("Реестр").Cells(y, 42).Value And Sheets("Реестр").Cells(y, 19).Value <> "Ипотечный" And Sheets("Реестр").Cells(y, 16).Value = "Г" Then Sheets("Сводный").Cells(x, 7).Value = Sheets("Сводный").Cells(x, 7).Value + 1
    Next y
Next x

[EducatedFool]

Файл Excel прикрепите - так проще будет понять, что вам требуется.

Обязательно макрос? Формулы не подойдут?

[Hugo121]

1. Вместо AND добавьте вторую/третью/четвёртую вложенную проверку If Then - так отсеете сразу ненужные проверки (первым проверяйте то, что совпадает реже).
2. Быстрее конечно перебирать массивы из диапазонов, а не диапазоны.